○第121回目 印刷属性のコピー
印刷属性のコピーです。
具体的には、
用紙の大きさ、向き
拡大縮小
各マージン
ヘッダーとフッタ
列及び行見出し
印刷範囲
など
を、ほとんどそっくりそのまま、他のシートにコピーしようというものです。
(まずは、一つのシートのみにコピーすることからはじめましょう。次に適用するシートの範囲を指定できることを考えましょう。実は番号の指定機能は既に図形作成システムでできあがっています。そこでは、"1.5-8.12.20-23"という与え方が可能です。これを借用しましょう)
印刷書式の設定をマクロの記録で取ってみますと、
おおむね次のとおりとなります(一部分)。
With ActiveSheet.PageSetup
.RightHeader = "&D;&T"
.RightFooter = "&9&Z&F&A"
.LeftMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.62992125984252)
' .Orientation = xlLandscape
' .PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
これは印刷属性の設定です。
そして、この右辺側は変数でも可能です。
次に、もとのシートから印刷属性を取得です。
印刷属性の取得はどうなるでしょうか。
With ActiveSheet.PageSetup
mi_r = .PrintTitleRows
End With
つまりイコールの左右を逆にすればいいことになります。
とても簡単です。
このように取得した印刷属性を、コピー先のシートに行き、設定してあげればよいことになります。
この中から必要なものを選んでやってみてください。
With ActiveSheet.PageSetup
.PrintTitleRows = mi_r
.PrintTitleColumns = mi_c
.PageSetup.PrintArea = p_a
.LeftHeader = h_l
.CenterHeader = h_c
.RightHeader = h_r
.LeftFooter = f_l
.CenterFooter = f_c
.RightFooter = f_r
.LeftMargin = m_l
.RightMargin = m_r
.TopMargin = m_t
.BottomMargin = m_b
.HeaderMargin = m_h
.FooterMargin = m_f
.CenterHorizontally = c_h
.CenterVertically = c_v
.Orientation = y_muki
.PaperSize = y_size
.FirstPageNumber = f_p_n
.Order = p_o
.Zoom = p_zoom
.FitToPagesWide = f_p_w
.FitToPagesTall = f_p_t
.PrintErrors = p_e
End With
おしまい。
2009年6月20日土曜日
2009年6月14日日曜日
第120回目 ジャンプマクロ、違うファイル(ブック)へはできないものか
○第120回目 ジャンプマクロ、違うファイル(ブック)へはできないものか
これまでのジャンプでは、同一シート内のある場所又は、当該ブック内の他のシート内のある場所へジャンプするというものでした。
これと同様に、計算式等のコピーについても、同一ブック内という制約がありました。これを、開いているどのブックにも移動できるという機能を考えました。
結果的には、たいした手間もなくできました。
簡単にいうと、シートの時と同じように、開いているブック名を取得すれば大体は終了となります。
あれこれ調べていたら、参考になる例示がありましたので、それを元に作成してみました。
┏━━━━━━━━━━━━━━━━━━━━━━━━━┓
┃ http://www.happy500z.com/YNxv252.html#8
┃ 8) ブックが開いているか調べる
┃Sub ブックが開いているか調べる()
┃ ブック名 = "BBB.xls" 'BBBにはブック名を記入
┃ '※１
┃ For Each 各ブック In Workbooks
┃ If 各ブック.Name = ブック名 Then
┃ MsgBox "開いています。", , ブック名
┃ Exit Sub
┃ End If
┃ Next
┃ MsgBox "開いていません。", , ブック名
┃End Sub
┗━━━━━━━━━━━━━━━━━━━━━━━━━┛
□これを使いブック名を取得します。
'初期状態の情報を取得
fname1 = ActiveWorkbook.Name
shname1 = ActiveSheet.Name
ii_max = Sheets.Count
ii0 = ActiveSheet.Index
'開かれているブック名､数を取得する
b_name(0) = fname1
i = 1
For Each 各ブック In Workbooks
b_name(i) = 各ブック.Name
i = i + 1
Next
b_cnt = i - 1
□次の問題は、同一シート内のジャンプの操作の手間を少なくする工夫です。
ブックの指定で、当該ブックの当該シートの場合は、99(デフォルト値)
当該ブックの別のシートの場合は、0
別のブックの別のシートの場合は、1～
このために、ブック名の配列変数の0番目には、最初のブック名を入れています。(b_name(0) = fname1)
'ブックの移動
bk_no = InputBox("使用したいブックを指定してください。そのままは0。そのままのシートの場合は、99。 " & vbCrLf & _
"01=⇒" & b_name(1) & vbCrLf & _
"02=⇒" & b_name(2) & vbCrLf & _
"03=⇒" & b_name(3) & vbCrLf & _
【途中略】
"14=⇒" & b_name(14) & vbCrLf & _
"15=⇒" & b_name(15) & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=99)
bk_no0 = bk_no
If bk_no <> 15 Then bk_no = 0
□ブックの移動後に、移動先のブックでのシート属性、名を取得
'ブックの移動
Windows(b_name(bk_no)).Activate
'移動先のブックでのシートの属性取得
ii2 = ActiveSheet.Index
ii_max2 = Sheets.Count
'シート名の取得
cc = Sheets.Count
If cc > ll100 Then cc = ll100
For i = 1 To cc 'ワークシートの数だけ繰り返す
ww(i) = Sheets(i).Name 'シート名を取得する
Next i
'現在のシート番号の取得
For ii = 1 To cc
If ActiveSheet.Name = ww(ii) Then Exit For 'シート名と同じ番号を取得する
Next ii
sheet_no = ii
□シート番号を指定して、当該シートに移動する
msg00 = "飛び先のシート番号を入れてください。 "
h1 = InputBox(msg00 & Str(cc) & "以下。 キャンセルは999。そのままのシートの場合は、0。" & vbCrLf & msg01, "シート ジャンプ", 0)
h2 = Val(h1)
If h2 = 0 Then h2 = sheet_no '当該シートの場合
Sheets(h2).Select
※msg01には、シート番号とシート名をつなげて入れておきます。
※セルへの移動は、第25回を参照してください。
以上はジャンプ関係の処理ですが、圧倒的にはコピー機能でつかうほうが多いので、コピー機能の中に、他のブックに飛べるような機能を追加してください。コマンドをコピーだけでほとんどマクロは完成します(コピーの場合は、最後の"セルへの移動"の機能は省いてもいいと思います)。
筆者のコピー関係のマクロは、計算式のコピーと、値のコピーの二種類です。これをワンタッチ(Ctrl+QまたはCtrl+W)で動かすことができます。処理の範囲を開いているブック全部に広げたおかげで、だいぶ操作が楽になりました。
このところ他のブックを参照しながらの仕事が多くなったからだと思います。
※更なる改善点
・指定した情報を持っておき、次の指示の時の初期値としておく。次の処理も同じブックへコピーする場合、非常に便利。
・コピーの場合、コピー元の座標を指定するが、コピー先の別のブックのシートでも、同じ座標にするかどうかを聞く機能。同じ形式のシートになっている場合は、非常に便利。
・コピー終了後、コピー元に戻るかの指定
・逆指定によるコピー。コピー先から指定し、次にコピー元を指定する。
※コピー機能は、非常によく使うものです。そこで、上記のように他のブックにコピーできるもののほかに、同一シート内のコピーのみに特化したマクロも持っておくと便利です。他のブックへコピー、その次は、同一シート内にコピー、次は他のブックという場合もありますので、指示情報を生かすためです。
次回は、印刷属性のコピーを取り上げます。もちろん他のブックのシートまでコピーは可能です。この機能も便利の一言です。
これまでのジャンプでは、同一シート内のある場所又は、当該ブック内の他のシート内のある場所へジャンプするというものでした。
これと同様に、計算式等のコピーについても、同一ブック内という制約がありました。これを、開いているどのブックにも移動できるという機能を考えました。
結果的には、たいした手間もなくできました。
簡単にいうと、シートの時と同じように、開いているブック名を取得すれば大体は終了となります。
あれこれ調べていたら、参考になる例示がありましたので、それを元に作成してみました。
┏━━━━━━━━━━━━━━━━━━━━━━━━━┓
┃ http://www.happy500z.com/YNxv252.html#8
┃ 8) ブックが開いているか調べる
┃Sub ブックが開いているか調べる()
┃ ブック名 = "BBB.xls" 'BBBにはブック名を記入
┃ '※１
┃ For Each 各ブック In Workbooks
┃ If 各ブック.Name = ブック名 Then
┃ MsgBox "開いています。", , ブック名
┃ Exit Sub
┃ End If
┃ Next
┃ MsgBox "開いていません。", , ブック名
┃End Sub
┗━━━━━━━━━━━━━━━━━━━━━━━━━┛
□これを使いブック名を取得します。
'初期状態の情報を取得
fname1 = ActiveWorkbook.Name
shname1 = ActiveSheet.Name
ii_max = Sheets.Count
ii0 = ActiveSheet.Index
'開かれているブック名､数を取得する
b_name(0) = fname1
i = 1
For Each 各ブック In Workbooks
b_name(i) = 各ブック.Name
i = i + 1
Next
b_cnt = i - 1
□次の問題は、同一シート内のジャンプの操作の手間を少なくする工夫です。
ブックの指定で、当該ブックの当該シートの場合は、99(デフォルト値)
当該ブックの別のシートの場合は、0
別のブックの別のシートの場合は、1～
このために、ブック名の配列変数の0番目には、最初のブック名を入れています。(b_name(0) = fname1)
'ブックの移動
bk_no = InputBox("使用したいブックを指定してください。そのままは0。そのままのシートの場合は、99。 " & vbCrLf & _
"01=⇒" & b_name(1) & vbCrLf & _
"02=⇒" & b_name(2) & vbCrLf & _
"03=⇒" & b_name(3) & vbCrLf & _
【途中略】
"14=⇒" & b_name(14) & vbCrLf & _
"15=⇒" & b_name(15) & vbCrLf _
, xpos:=2000, ypos:=3000, Default:=99)
bk_no0 = bk_no
If bk_no <> 15 Then bk_no = 0
□ブックの移動後に、移動先のブックでのシート属性、名を取得
'ブックの移動
Windows(b_name(bk_no)).Activate
'移動先のブックでのシートの属性取得
ii2 = ActiveSheet.Index
ii_max2 = Sheets.Count
'シート名の取得
cc = Sheets.Count
If cc > ll100 Then cc = ll100
For i = 1 To cc 'ワークシートの数だけ繰り返す
ww(i) = Sheets(i).Name 'シート名を取得する
Next i
'現在のシート番号の取得
For ii = 1 To cc
If ActiveSheet.Name = ww(ii) Then Exit For 'シート名と同じ番号を取得する
Next ii
sheet_no = ii
□シート番号を指定して、当該シートに移動する
msg00 = "飛び先のシート番号を入れてください。 "
h1 = InputBox(msg00 & Str(cc) & "以下。 キャンセルは999。そのままのシートの場合は、0。" & vbCrLf & msg01, "シート ジャンプ", 0)
h2 = Val(h1)
If h2 = 0 Then h2 = sheet_no '当該シートの場合
Sheets(h2).Select
※msg01には、シート番号とシート名をつなげて入れておきます。
※セルへの移動は、第25回を参照してください。
以上はジャンプ関係の処理ですが、圧倒的にはコピー機能でつかうほうが多いので、コピー機能の中に、他のブックに飛べるような機能を追加してください。コマンドをコピーだけでほとんどマクロは完成します(コピーの場合は、最後の"セルへの移動"の機能は省いてもいいと思います)。
筆者のコピー関係のマクロは、計算式のコピーと、値のコピーの二種類です。これをワンタッチ(Ctrl+QまたはCtrl+W)で動かすことができます。処理の範囲を開いているブック全部に広げたおかげで、だいぶ操作が楽になりました。
このところ他のブックを参照しながらの仕事が多くなったからだと思います。
※更なる改善点
・指定した情報を持っておき、次の指示の時の初期値としておく。次の処理も同じブックへコピーする場合、非常に便利。
・コピーの場合、コピー元の座標を指定するが、コピー先の別のブックのシートでも、同じ座標にするかどうかを聞く機能。同じ形式のシートになっている場合は、非常に便利。
・コピー終了後、コピー元に戻るかの指定
・逆指定によるコピー。コピー先から指定し、次にコピー元を指定する。
※コピー機能は、非常によく使うものです。そこで、上記のように他のブックにコピーできるもののほかに、同一シート内のコピーのみに特化したマクロも持っておくと便利です。他のブックへコピー、その次は、同一シート内にコピー、次は他のブックという場合もありますので、指示情報を生かすためです。
次回は、印刷属性のコピーを取り上げます。もちろん他のブックのシートまでコピーは可能です。この機能も便利の一言です。
2009年6月7日日曜日
○第119回目 計算式をチェックする(その6)
○第119回目 計算式をチェックする(その6)
前回の宿題です。ｎ回目のチェックをしている時、チェック元のシート上の座標と計算式を格納する配列変数の添え字との関係は、というものでした。
まず記号の整理をします。
シートの有効範囲の最後は…gyo1とretu1とします。
チェック範囲の先頭は…g20とr20とします。
今チェックしているセルの座標は、i行、j列とします。
i行は、チェック範囲のたて位置を200で区切ったとき位置は次のようになります。
(Int((i - g20) / ll200) + 1)
先頭位置を20行と仮定すると、219行までは一番目のブロック、220行からは二番目のブロックとなります。
同様に、j列は
(Int((j - r20) / ll150) + 1)
となります。
ブロック内のi行の位置は、g20 と ブロック番号-1 掛ける 200 をiから引いたものに +1 したものになります。
i - g20 - [(Int((i - g20) / ll200) + 1) - 1]*200 + 1
i = 219では、219 - 20 - (0 + 1 - 1) * 200 + 1 = 200となります。
i = 220では、220 - 20 - (1 + 1 - 1) * 200 + 1 = 1となります。
このような変換式で、セルの座標が配列変数の添え字と結び付けられます。
(列も同様です)
チェックの回数は、i、jに依存しているので不要でした。
宿題はおしまい。
また、今の例でのチェックの範囲の先頭の行は、
ｘ- 20 - (0 + 1 - 1) * 200 + 1 = 1
ｘ- 20 - (1 + 1 - 1) * 200 + 1 = 1
を解けばいいことになります。それぞれｘは、20と220になります。
これから、チェック範囲の最後も出てきます。チェック範囲の最後はシートの有効範囲を超えませんので注意願います。
7.元のシートでの計算式の中のシート名をチェック先のシート名に置き換える
それぞれのシート名は、ww1()、ww2()にありますので、違っている場合のみ、ww1()をww2()に変換してください。
'シート名の変換。nはシート数の添え字。
For n = 1 To ii_max
If ww1(n) <> ww2(n) Then
Do While 1
p1 = InStr(mm(j1, i1), ww1(n))
If p1 = 0 Then Exit Do
mm(j1, i1) = Left$(mm(j1, i1), p1 - 1) & ww2(n) & Mid$(mm(j1, i1), p1 + Len(ww1(n)))
Loop
End If
Next n
8.チェック先のファイルの同番号のシートを指定して、チェック範囲内の計算式と、既に取得した計算式との同一チェック
計算式で違う箇所は大体はシート名なので、シート名を変換してやれば一致するはずです。変換は7.でおこなっているので同一性の比較は単純にやればいいことになります。
この段階で、チェックする範囲の色をチェック範囲の色に全部変えます。その上でチェックでエラーになった場合のみ、指定の色をつけるということにします。
有り有りで同一＝⇒何もしない
有り有りで違う＝⇒3 赤色
有り無し ＝⇒7 濃い桃色
無し有り ＝⇒40 肌色
If a <> "" And mm(j1, i1) <> "" Then
If a <> mm(j1, i1) Then Cells(i, j).Interior.ColorIndex = 3: err_cnt1(m) = err_cnt1(m) + 1 '赤色
If a = "" And mm(j1, i1) <> "" Then Cells(i, j).Interior.ColorIndex = 7: err_cnt2(m) = err_cnt2(m) + 1 '濃い桃色
If a <> "" And mm(j1, i1) = "" Then Cells(i, j).Interior.ColorIndex = 40: err_cnt3(m) = err_cnt3(m) + 1 '肌色
※ここでいう変数aは、チェック先のセルの計算式のことです。
err_cnt1(m)の添え字は、チェック回数のことです。
9.チェック単位でエラー件数を表示する
8.でエラーに該当したら、エラー件数をカウントしておきましょう。1回のチェックが終わったら、msgboxでエラー件数を表示しておきます。
エラー件数以外には、チェックしたシート名とチェック範囲を表示します。
10.チェック回数だけ繰り返す。チェック単位数の最大は100回とする(時間が分単位でかかる)
100回の場合かなり時間がかかります。とりあえずは、巨大な表が対象となる場合があるとするならば、20回ぐらいで試してみてはどうでしょうか。
11.次のシートへの処理に行き、繰り返す
※現在の問題点
現在チェックできるのは、ファイルが異なっても、パラメータは同じシートの同じ座標になっている場合です。
しかし、例えば男女別にファイルは分かれているが、パラメータは男女とも、例えば、男のファイルのあるシートに両方が入っている場合があります。この場合はパラメータの座標が男女で異なります。
これには対応できないのです。男のファイルには男のパラメータしか入っていなくて、女のパラメータと同じ座標だという場合しかできないということです。
この場合がことごとくエラーになってしまうのです。
使っている座標が違うのですからエラーとするのが当然ですが、よくみるとそのパラメータの箇所だけが違っていて、後はまったく同じなのです。つまり、正しい計算式なのです。このような場合は現時点ではお手上げですが、何とかならないのか、と思っています。
エラー箇所が少なければいいのですが、このエラーが2万セルもあると、手作業で確認していくのは不可能になってしまいます。
正当もどきの計算式をどうやって、本当のエラーから区分したらよいのか？
例えば、
1回目は無条件にチェックをかける。
→エラー原因を分析し、それが正当と判断できれば、変換表を作り、座標の列記号を変換して、再度チェックをかけるというのはどうかと思っています。
変換表のファイルをあけておき、そこから列記号の変換表を入手するという構想です。
当初考えていたものより、かなり複雑なものに発展してきてしまいました。
ファイル間の計算式同一性チェックは、当面は荷が重いということにしておきましょう。
前回の宿題です。ｎ回目のチェックをしている時、チェック元のシート上の座標と計算式を格納する配列変数の添え字との関係は、というものでした。
まず記号の整理をします。
シートの有効範囲の最後は…gyo1とretu1とします。
チェック範囲の先頭は…g20とr20とします。
今チェックしているセルの座標は、i行、j列とします。
i行は、チェック範囲のたて位置を200で区切ったとき位置は次のようになります。
(Int((i - g20) / ll200) + 1)
先頭位置を20行と仮定すると、219行までは一番目のブロック、220行からは二番目のブロックとなります。
同様に、j列は
(Int((j - r20) / ll150) + 1)
となります。
ブロック内のi行の位置は、g20 と ブロック番号-1 掛ける 200 をiから引いたものに +1 したものになります。
i - g20 - [(Int((i - g20) / ll200) + 1) - 1]*200 + 1
i = 219では、219 - 20 - (0 + 1 - 1) * 200 + 1 = 200となります。
i = 220では、220 - 20 - (1 + 1 - 1) * 200 + 1 = 1となります。
このような変換式で、セルの座標が配列変数の添え字と結び付けられます。
(列も同様です)
チェックの回数は、i、jに依存しているので不要でした。
宿題はおしまい。
また、今の例でのチェックの範囲の先頭の行は、
ｘ- 20 - (0 + 1 - 1) * 200 + 1 = 1
ｘ- 20 - (1 + 1 - 1) * 200 + 1 = 1
を解けばいいことになります。それぞれｘは、20と220になります。
これから、チェック範囲の最後も出てきます。チェック範囲の最後はシートの有効範囲を超えませんので注意願います。
7.元のシートでの計算式の中のシート名をチェック先のシート名に置き換える
それぞれのシート名は、ww1()、ww2()にありますので、違っている場合のみ、ww1()をww2()に変換してください。
'シート名の変換。nはシート数の添え字。
For n = 1 To ii_max
If ww1(n) <> ww2(n) Then
Do While 1
p1 = InStr(mm(j1, i1), ww1(n))
If p1 = 0 Then Exit Do
mm(j1, i1) = Left$(mm(j1, i1), p1 - 1) & ww2(n) & Mid$(mm(j1, i1), p1 + Len(ww1(n)))
Loop
End If
Next n
8.チェック先のファイルの同番号のシートを指定して、チェック範囲内の計算式と、既に取得した計算式との同一チェック
計算式で違う箇所は大体はシート名なので、シート名を変換してやれば一致するはずです。変換は7.でおこなっているので同一性の比較は単純にやればいいことになります。
この段階で、チェックする範囲の色をチェック範囲の色に全部変えます。その上でチェックでエラーになった場合のみ、指定の色をつけるということにします。
有り有りで同一＝⇒何もしない
有り有りで違う＝⇒3 赤色
有り無し ＝⇒7 濃い桃色
無し有り ＝⇒40 肌色
If a <> "" And mm(j1, i1) <> "" Then
If a <> mm(j1, i1) Then Cells(i, j).Interior.ColorIndex = 3: err_cnt1(m) = err_cnt1(m) + 1 '赤色
If a = "" And mm(j1, i1) <> "" Then Cells(i, j).Interior.ColorIndex = 7: err_cnt2(m) = err_cnt2(m) + 1 '濃い桃色
If a <> "" And mm(j1, i1) = "" Then Cells(i, j).Interior.ColorIndex = 40: err_cnt3(m) = err_cnt3(m) + 1 '肌色
※ここでいう変数aは、チェック先のセルの計算式のことです。
err_cnt1(m)の添え字は、チェック回数のことです。
9.チェック単位でエラー件数を表示する
8.でエラーに該当したら、エラー件数をカウントしておきましょう。1回のチェックが終わったら、msgboxでエラー件数を表示しておきます。
エラー件数以外には、チェックしたシート名とチェック範囲を表示します。
10.チェック回数だけ繰り返す。チェック単位数の最大は100回とする(時間が分単位でかかる)
100回の場合かなり時間がかかります。とりあえずは、巨大な表が対象となる場合があるとするならば、20回ぐらいで試してみてはどうでしょうか。
11.次のシートへの処理に行き、繰り返す
※現在の問題点
現在チェックできるのは、ファイルが異なっても、パラメータは同じシートの同じ座標になっている場合です。
しかし、例えば男女別にファイルは分かれているが、パラメータは男女とも、例えば、男のファイルのあるシートに両方が入っている場合があります。この場合はパラメータの座標が男女で異なります。
これには対応できないのです。男のファイルには男のパラメータしか入っていなくて、女のパラメータと同じ座標だという場合しかできないということです。
この場合がことごとくエラーになってしまうのです。
使っている座標が違うのですからエラーとするのが当然ですが、よくみるとそのパラメータの箇所だけが違っていて、後はまったく同じなのです。つまり、正しい計算式なのです。このような場合は現時点ではお手上げですが、何とかならないのか、と思っています。
エラー箇所が少なければいいのですが、このエラーが2万セルもあると、手作業で確認していくのは不可能になってしまいます。
正当もどきの計算式をどうやって、本当のエラーから区分したらよいのか？
例えば、
1回目は無条件にチェックをかける。
→エラー原因を分析し、それが正当と判断できれば、変換表を作り、座標の列記号を変換して、再度チェックをかけるというのはどうかと思っています。
変換表のファイルをあけておき、そこから列記号の変換表を入手するという構想です。
当初考えていたものより、かなり複雑なものに発展してきてしまいました。
ファイル間の計算式同一性チェックは、当面は荷が重いということにしておきましょう。
登録:
コメント (Atom)
