Q&A
下記は不要では？
＞ ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value
VBA超初心者です。
調べながら時間をかけてコードを作りました。
簡単なコードだと思いますが、動いたことに喜びを感じています。
以下は作成したコードです
Option Explicit Sub 印刷と保存() Dim i Dim filename As String '保存先フォルダパスとファイル名 Dim filename2 Dim na Dim name As String '保存ファイル名 Dim name2 Dim insatsu As Long Dim save As Long Dim folder If Range("j5") = 0 Then MsgBox ("処理番号が空白です。一覧を確認してください") Worksheets("一覧").Select Exit Sub End If ''請求書の振込先を入力 'If Range("A4") = "御請求書" Then ' Worksheets("振込先").Select ' activesheets.Shapes.Copy ' Worksheets("振込先").Select ' activesheets.Paste ' Selection.Top 'ファイル名を作成 na = Range("g5") & "_" & Range("b7") name = Range("g5") & "_" & Range("b7") & ".pdf" name2 = Range("g5") & "_" & Range("b7") & ".xlsx" 'パスを作成（フォルダ、PDF、エクセル） folder = ThisWorkbook.Path & "\" & "保存" filename = ThisWorkbook.Path & "\" & "保存" & "\" & name filename2 = ThisWorkbook.Path & "\" & "保存" & "\" & name2 If Dir(folder, vbDirectory) = "" Then MkDir folder End If If Dir(filename) <> "" Then save = MsgBox("既に" & na & "は存在します。上書き保存しますか？", vbYesNo, "確認") If save = vbNo Then MsgBox ("何もせず終了します") Exit Sub End If Application.DisplayAlerts = False Application.DisplayAlerts = True insatsu = MsgBox("上書き保存した「" & name & "」を印刷しますか？", vbYesNo, "確認") If insatsu = 6 Then Range("h6").Interior.ColorIndex = 0 '塗りつぶしをクリアに With ActiveSheet.PageSetup '１ページに収まるように印刷 .Orientation = xlPortrait .Zoom = False .FitToPagesTall = 1 .FitToPagesWide = 1 End With With ActiveSheet .PrintOut Preview:=True .ExportAsFixedFormat Type:=xlTypePDF, filename:=filename 'PDFに変換 .Range("h6").Interior.Color = RGB(255, 255, 0) '塗りつぶしを黄色に（元通りに） .Copy End With ActiveWorkbook.SaveAs filename2 ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value ActiveSheet.Range("h6").Interior.ColorIndex = 0 ActiveSheet.Columns("i:m").Delete Sheets(1).name = Range("G5") ActiveWorkbook.Close Else With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, filename:=filename 'PDFに変換 .Range("h6").Interior.Color = RGB(255, 255, 0) '塗りつぶしを黄色に（元通りに） .Copy End With ActiveWorkbook.SaveAs filename2 ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value ActiveSheet.Range("h6").Interior.ColorIndex = 0 ActiveSheet.Columns("i:m").Delete Sheets(1).name = Range("G5") ActiveWorkbook.Close End If Exit Sub Else Range("h6").Interior.ColorIndex = 0 '塗りつぶしをクリアに With ActiveSheet.PageSetup '１ページに収まるように印刷 .Orientation = xlPortrait .Zoom = False .FitToPagesTall = 1 .FitToPagesWide = 1 End With With ActiveSheet .PrintOut Preview:=True .ExportAsFixedFormat Type:=xlTypePDF, filename:=filename 'PDFに変換 .Range("h6").Interior.Color = RGB(255, 255, 0) '塗りつぶしを黄色に（元通りに） .Copy End With ActiveWorkbook.SaveAs filename2 ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value ActiveSheet.Range("h6").Interior.ColorIndex = 0 ActiveSheet.Columns("i:m").Delete Sheets(1).name = Range("G5") ActiveWorkbook.Close End If End Sub
この中に、
同じプログラムコードを何度も使いまわしている
部分があります。
ActiveWorkbook.SaveAs filename2 ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value ActiveSheet.Range("h6").Interior.ColorIndex = 0 ActiveSheet.Columns("i:m").Delete Sheets(1).name = Range("G5") ActiveWorkbook.Close
現在は、その部分をコピーして、必要なところにペーストして使いまわしています。
ただ、修正が必要になった時も同じように全てをコピー＆ペーストしなければいけないので、
効率が悪いのと修正を忘れる可能性があるので、一か所を修正したら全て反映されるような
方法があるのでは？と思いました。
ネットで調べようと思いましたが、どのような単語で調べてよいのかわからず、
ご質問させていただきました。
mag_様
質問以外のところまでみていただきありがとうございます。
元々、指定している範囲には関数などが入っています。値で貼付けをしたいので、今回のように
しています。調べた方法が上記のような書き方だったので、それに従って作ってみました。
回答3件
0
ベストアンサー
一般的に同じコードが繰り返し登場する場合、他の回答にあるように関数化を行うことで効率よくコーディングすることが可能ですが、今回の質問で問題視しているコードの箇所にはその必要性を感じません。
なぜなら同じコードは必ず分岐処理の最後に書かれているため、関数内の最後に記述することで同様の処理が行えるためです。
それよりも関数化するのであれば、印刷処理（2回登場します）、PDF変換処理（1回の登場ですが印刷同様に関数化したほうが見やすい）を関数化したほうがよいでしょう。
以下に修正したコードを提示しますので参考にしてください。
尚、インデントとMsgBoxの戻り値の判定を6→vbYesに修正しています。
VBA
1Option Explicit 2 3Sub 印刷と保存() 4 5 Dim i 6 Dim filename As String '保存先フォルダパスとファイル名 7 Dim filename2 8 Dim na 9 Dim name As String '保存ファイル名 10 Dim name2 11 Dim insatsu As Long 12 Dim save As Long 13 Dim folder 14 15 If Range("j5") = 0 Then 16 MsgBox ("処理番号が空白です。一覧を確認してください") 17 Worksheets("一覧").Select 18 Exit Sub 19 End If 20 21 ''請求書の振込先を入力 22 'If Range("A4") = "御請求書" Then 23 ' Worksheets("振込先").Select 24 ' activesheets.Shapes.Copy 25 ' Worksheets("振込先").Select 26 ' activesheets.Paste 27 ' Selection.Top 28 29 'ファイル名を作成 30 na = Range("g5") & "_" & Range("b7") 31 name = Range("g5") & "_" & Range("b7") & ".pdf" 32 name2 = Range("g5") & "_" & Range("b7") & ".xlsx" 33 34 'パスを作成（フォルダ、PDF、エクセル） 35 folder = ThisWorkbook.Path & "\" & "保存" 36 filename = ThisWorkbook.Path & "\" & "保存" & "\" & name 37 filename2 = ThisWorkbook.Path & "\" & "保存" & "\" & name2 38 39 If Dir(folder, vbDirectory) = "" Then 40 MkDir folder 41 End If 42 43 If Dir(filename) <> "" Then 44 45 save = MsgBox("既に" & na & "は存在します。上書き保存しますか？", vbYesNo, "確認") 46 If save = vbNo Then 47 MsgBox ("何もせず終了します") 48 Exit Sub 49 End If 50 51 insatsu = MsgBox("上書き保存した「" & name & "」を印刷しますか？", vbYesNo, "確認") 52 If insatsu = vbYes Then 53 Call Insatsu 54 Else 55 Call Pdf 56 End If 57 Else 58 Call Insatsu 59 End If 60 61 ActiveWorkbook.SaveAs filename2 62 ActiveSheet.Range("a1:h46").Value = ActiveSheet.Range("a1:h46").Value 63 ActiveSheet.Range("h6").Interior.ColorIndex = 0 64 ActiveSheet.Columns("i:m").Delete 65 Sheets(1).name = Range("G5") 66 ActiveWorkbook.Close 67 68End Sub 69 70Sub Insatsu(filename As String) 71 Range("h6").Interior.ColorIndex = 0 '塗りつぶしをクリアに 72 With ActiveSheet.PageSetup '１ページに収まるように印刷 73 .Orientation = xlPortrait 74 .Zoom = False 75 .FitToPagesTall = 1 76 .FitToPagesWide = 1 77 End With 78 With ActiveSheet 79 .PrintOut Preview:=True 80 .ExportAsFixedFormat Type:=xlTypePDF, filename:=filename 'PDFに変換 81 .Range("h6").Interior.Color = RGB(255, 255, 0) '塗りつぶしを黄色に（元通りに） 82 .Copy 83 End With 84End Sub 85 86Sub Pdf(filename As String) 87 With ActiveSheet 88 .ExportAsFixedFormat Type:=xlTypePDF, filename:=filename 'PDFに変換 89 .Range("h6").Interior.Color = RGB(255, 255, 0) '塗りつぶしを黄色に（元通りに） 90 .Copy 91 End With 92End Sub
投稿2020/10/19 04:32
総合スコア16998
ttyp03様
ありがとうございます。
今回に限ってはあまり重く考える必要はないんですね。質問以外のところまで見ていただき大変感謝です。勉強になります。コードになれていないので少し理解するのに時間がかかってしまいますが、読み解いて次回作成時に取り入れられるようにします。
0
一か所を修正したら全て反映されるような
方法があるのでは？と思いました。
そのような方法があったとして、それだけのコード量が残り続けるのは結局同じです。
そういう方法を考えるのではなく「処理の共通化」を考えたほうが良いです。
VBAにはfunctionやSubといったプロシージャがあります。
他の言語では「関数」と呼ばれるもの。
何かしらの情報を引数、パラメータとして渡せばその情報を使って一定の処理をさせるものです。
各画面やシートから呼び出したいのでしたら「標準モジュール」に定義しておくことで
共通関数として呼び出すこともできます。
投稿2020/10/19 04:13
編集2020/10/19 04:16
総合スコア80850
別の質問への回答ではありませんか？（追記：先ほどまで編集履歴とも違う別の回答が表示されていたのでコメントしました）
Ctrl＋Enterを押してしまったのですけど、その時点では冒頭の質問本文引用だけの回答だったんです。（すぐ「編集」で確認）
別の質問への回答の内容が有効になってしまったようなので、投稿バグだと思います。
ただ、これはさすがに初めてですね。
m.ts10806様
ご回答いただきありがとうございます。
「処理の共通化」というキーワードリストですね、ありがとうございます。次回、調べる機会があるときに頭の中にとどめておきます。
あくまでどれくらい利用されるかという全体のバランスや頻度から考えると良いと思います。
変数とかも考え方としては同じですね。ローカルで持つのかグローバルで持つのか。
あなたの回答
tips
プレビュー
