Excel帳票のデータ保存はVBA誤動作の対策を必ずしよう。

Excel帳票では、データの保存について注意が必要です。

特にExcel帳票をVBAで自動化している場合です。

VBAは事務効率の面で重要ですが、適切な処理が無ければ、その誤動作には要注意です。

間違いなくタダの「Excelブック（.xlsx）」で保存しなければなりません。

Sub 伝票保存()

 

Dim FolderPathD As String
Dim Shell As Object
Dim Newbook As Object
Dim FP As String, FPN As String, FPM As String, FPMN As String
Dim FPL As String, FPLN As String, FN As String
Dim a As Long

 

　’保存フォルダを選択
　　Mypath = ThisWorkbook.Path & “\作成伝票”

　　Set Shell = CreateObject(“Shell.Application”) _
　　　　.BrowseForFolder(0, “フォルダを選択してください”, &H1, Mypath)

　　If Shell Is Nothing Then
　　　　FolderPathD = “”
　　　　Exit Sub
　　Else
　　　　FolderPathD = Shell.Items.Item.Path
　　End If

’フォルダ名の取得
　　FP = FolderPathD
　　FPN = Mid(FP, InStrRev(FP, “\”) + 1)
　　FPM = Left(FP, InStrRev(FP, “\”) – 1)
　　FPMN = Mid(FPM, InStrRev(FPM, “\”) + 1)
　　FPL = Left(FPM, InStrRev(FPM, “\”) – 1)
　　FPLN = Mid(FPL, InStrRev(FPL, “\”) + 1)

　’ファイルを保存
　　ChDir FP

　　Set Newbook = Workbooks.Add
　　For a = 2 To 4
　　　　Workbooks(“見納請3点伝票作成.xlsm”).Activate
　　　　Worksheets(a).Cells.Copy
　　　　Newbook.Activate
　　　　Worksheets(“sheet” & a – 1).Select
　　　　With ActiveSheet
　　　　　　.Paste
　　　　　　.Name = Workbooks(“見納請3点伝票作成.xlsm”).Worksheets(a).Name
　　’行高さ設定
　　　　　　.Rows.RowHeight = 24
　　　　　　.Rows(“1:12”).RowHeight = 19.5
　　　　　　.Rows(2).RowHeight = 9
　　　　　　.Rows(4).RowHeight = 7.5
　　　　　　.Rows(“7:9”).RowHeight = 15.75
　　　　　　.Rows(10).RowHeight = 6.75
　　　　　　.Rows(11).RowHeight = 22.5
　　　　　　.Range(“A1”).Select
　　’印刷余白の設定
　　　　　　.PageSetup.TopMargin = Application.CentimetersToPoints(1.5)
　　　　　　.PageSetup.LeftMargin = Application.CentimetersToPoints(2.5)
　　　　　　.PageSetup.RightMargin = Application.CentimetersToPoints(1)
　　　　　　.PageSetup.BottomMargin = Application.CentimetersToPoints(1)
　　　　　　.PageSetup.HeaderMargin = Application.CentimetersToPoints(0.5)
　　　　　　.PageSetup.FooterMargin = Application.CentimetersToPoints(0.5)
　　’プリントタイトル
　　　　　　.PageSetup.PrintTitleRows = “$13:$13”
　　　　End With
　　Application.CutCopyMode = False
　　Next a

　’保存ファイルに名前を付ける
　　FN = Format(Now(), “yymmdd-hhmm”)

　　If FPN = “作成伝票” Then
　　　　Newbook.SaveAs Filename:=FolderPathD & “\” & FPN & “請求書_” & FN & “.xlsx”
　　ElseIf FPMN = “作成伝票” Then
　　　　Newbook.SaveAs Filename:=FolderPathD & “\” & FPN & “請求書_” & FN & “.xlsx”
　　ElseIf FPLN = “作成伝票” Then
　　　　Newbook.SaveAs Filename:=FolderPathD & “\” & FPMN & FPN & “請求書_” & FN & “.xlsx”
　　Else
　　　　Newbook.SaveAs Filename:=FolderPathD & “\” & FPLN & FPMN & FPN & “請求書_” & FN & “.xlsx”
　　End If

　　Range(“A1”).Select

　　Newbook.Close
　　Workbooks(“見納請3点伝票作成.xlsm”).Activate
　　Worksheets(“作業シート”).Activate
　　Range(“A1”).Select

 

End Sub

テンプレートを再生するためには、改めて各行の高さ情報をコードにセットする必要があります。

印刷余白も改めてコードをセットします。

プリントタイトルも再設定します。

「１階層下フォルダ名」「２階層下フォルダ名」「３階層下フォルダ名」請求書_年月日-時分

＜記事内容についての告知＞VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません