作成帳票の保存は、必要個所をマクロなしエクセルブックで

作成帳票の保存は、必要な部分だけをマクロなしエクセルブックで行いましょう。不要なVBAコードも同時に保存してしまうマクロ付き保存はトラブルの原因にもなります。

こんにちは、じゅんぱ店長（@junpa33）です。

販売帳票（見積書、納品書、請求書）を自動で作成するエクセルソフトの組み立てについてです。

今回は第４回目です。完成した帳票をファイル名を付けて、保存用に所定の別フォルダーに別名保存できるようにします。

ただし、マクロ付きエクセルブックの保存については、

リネームして「名前を付けて保存」を行ってもマクロ事故が起こるかもしれません。

一つ前の記事を確認するのは、こちら↓になります。

2020年10月11日作成した帳票の印刷設定はVBAで自動化できる

見積書納品書請求書作成の記事編成

見積書納品書請求書作成ソフトの使い方とダウンロード
- 見積書納品書請求書作成ソフトの無料ダウンロードと取説

見積書納品書請求書作成ソフトの作成概略
- 見積・納品・請求書を同一書式で作成できるExcelVBA

見積書納品書請求書作成ソフトの作成手順

コンテンツ

マクロ付きエクセルブックの別名保存の危うさ

Excel VBAを使って、データ資料を作っている方なら経験があると思いますが、

複数のエクセルブックを開いていたら、何かのキッカケでVBAの誤動作が起こりセルデータがおかしくなった。

なんて経験がある人もいると思います。

あちゃ～😵なんて　シャレにならない事経験ありませんか。

保存したデータが改変されてしまう事も

実はそれは、マクロ（VBA）が誤動作したわけでもなくて、複数開いているエクセルのアクティブ状態が違っていたからです。

例えば　こんなVBAコード

VBA

Option Explicit

Sub クリア()
        With Worksheets("Sheet1")
            .Cells.Clear
            .DrawingObjects.Delete
        End With
End Sub

あるマクロ付きエクセルブックでこのようなVBAが記述されていて、同時に他のエクセルブックを複数開いていたとします。

「他のエクセルブック」がアクティブ状態で、たまたま、この「クリア」マクロが実行されたとしたら・・・

「他のエクセルブック」の「Sheet1」は真っ白な状態にクリアされてしまいます。

このVBAはアクティブブックに対して実行されるコードになっています。

無用にマクロ付きエクセルブックを増やさない

皆さんは、作成したVBAマクロ付きのエクセルを、保存用にリネームして丸々そのまま「エクセルマクロ有効ブック」で保存していませんか？

エクセルの保存ダイアログは、基本、同じ種類のブックで保存する用に表示されます。

マクロ有効ブックをそのまま安易に保存すると、データ保存用にした別名エクセルブックも「VBAコードは有効」状態になっています。

データ保存用としてマクロの付いたエクセルブックを保存する場合は、「.xlsx」マクロなしエクセルブックで保存するようにしましょう。

記述されたVBAを無効にするためには、

「Excelブック（.xlsx）」で保存することでVBAが無効となります。

VBAが記述されたエクセルブックを無用に増やさないことが、VBAの誤操作を減らせる一つの方策ともなります。

目次へ戻る

作成帳票の保存は別名のマクロなしエクセルブック

この「見積納品請求書作成エクセルソフト」について、作成した「見積書」「納品書」「請求書」の3シートだけを別名エクセルブックにコピーして保存します。

作成した帳票を保存するためのVBA

VBAを動かしているエクセルBOOKは「エクセルマクロ有効ブック（.xlsm）」で作られていますが、名前を変えて保存する帳票保存のエクセルBOOKは「Excelブック（.xlsx）」とします。

データとして保存する部分も、３つのシート「請求書」・「納品書」・「見積書」だけです。

VBAコードはModule4に記述していきます。新たにモジュールを挿入してください。

2020年11月13日 VBA初めての起動。VBEの立ち上げ、保存と終了

データ保存のVBAコードの全体

VBA

Option Explicit

Sub 伝票保存()
    Dim Mypath, FolderPathD As String
    Dim Shell As Object
    Dim Newbook As Object
    Dim FP, FPN, FPM, FPMN As String
    Dim FPL, FPLN, FN, NbkN 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
'印刷余白の設定
                With .PageSetup
                    .TopMargin = Application _
                                .CentimetersToPoints(1.5)
                    .LeftMargin = Application _
                                .CentimetersToPoints(2.5)
                    .RightMargin = Application _
                                .CentimetersToPoints(1)
                    .BottomMargin = Application _
                                .CentimetersToPoints(1)
                    .HeaderMargin = Application _
                                .CentimetersToPoints(0.5)
                    .FooterMargin = Application _
                                .CentimetersToPoints(0.5)
'プリントタイトル
                    .PrintTitleRows = "$13:$13"
                End With
            End With
            Application.CutCopyMode = False
        Next a
    '保存ファイルに名前を付ける
        FN = Format(Now(), "yymmdd-hhmm")
        With Newbook
            If FPN = "作成伝票" Then
                .SaveAs Filename:=FolderPathD & "\" _
                            & FPN & "請求書_" & FN & ".xlsx"
            ElseIf FPMN = "作成伝票" Then
                .SaveAs Filename:=FolderPathD & "\" _
                            & FPN & "請求書_" & FN & ".xlsx"
            ElseIf FPLN = "作成伝票" Then
                .SaveAs Filename:=FolderPathD & "\" _
                        & FPMN & FPN & "請求書_" & FN & ".xlsx"
            Else
                .SaveAs Filename:=FolderPathD & "\" _
                & FPLN & FPMN & FPN & "請求書_" & FN & ".xlsx"
            End If
            NbkN = .Name
            .Close
        End With
        Workbooks("見納請3点伝票作成.xlsm").Activate
        Worksheets("作業シート").Activate
        Range("A1").Select
        MsgBox NbkN & "　で帳票の保存を行ないました。", _
                    vbInformation, "見納請3点伝票作成"
End Sub

保存フォルダを選択

「作成伝票」というフォルダは名称固定で、このエクセルブックと同列（同じディレクトリ）で設置必須です。

このコードが実行されると、この「作成伝票」から下層がツリー表示されます。