派遣事務員の迷走

派遣事務員コロ子。会社の犬。顔出しNG。常に迷走している。

VBA ひな型を壊さないようにするには?

こんにちは。
派犬事務員のコロ子です。

今月から「ノンプログラマーのためのスキルアップ研究会」初心者講座VBA コース6期が始まりました。講師はichihuku@VBAerさんです。コロ子は僭越ながらTA(ティーチングアシスタント)をさせて頂いてます。

TAは何度やっても勉強になる

コロ子ばっかり何度もTAやらせてもらってありがとうございます。TAは本当に何度やっても勉強になる。
ノンプロ研の講座は事前課題がかなり大量に出るけど、みんなちゃんとやってくるのがすごい。事前課題でもらった質問の解決法を書いてみます。

ひな型が上書きされちゃう問題

【課題】
元の課題はこれだけど、
atmarkit.itmedia.co.jp

説明を簡単にするためにちょっとアレンジします。

下記の書式の注文書を

注文書ひな型.xlsx

リストのデータ分だけ作りたい。

リスト.xlsm

【作成方法】
① 注文書ひな型を開く
② リストデータを注文書ひな型に転記する
③ 名前をつけて保存(ファイル名:注文書(名前).xlsx)
④ ②③をリストのデータの数だけ繰り返す
⑤ 注文書ひな型を閉じる(保存しない)


リスト.xlsmのシートモジュールに下記コードを記載する

Sub 注文書作成()

    Dim wb As Workbook
    Dim ws As Worksheet
    
    '注文書ひな型を開く
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\注文書ひな型.xlsx")
    Set ws = wb.Worksheets("ひな型")
    
    'リストをデータの数だけループする
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        'リストのデータをひな形に転記
        
        Dim strName As String
        strName = Cells(i, 2).Value
        
        ws.Range("C5").Value = strName '名前
        ws.Range("C10").Value = Cells(i, 1).Value '日付
        ws.Range("D10").Value = Cells(i, 3).Value '品名
        ws.Range("E10").Value = Cells(i, 4).Value '金額
        
        'ブックを別名で保存
        wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx"
        
    Next i
    
    '注文書ひな型を閉じる(保存しない)
    wb.Close

End Sub

コードを実行すると、各々の注文書ができている。

注文書ができてる

このような処理は本当に良く使う。

で、頂いた質問は「注文書ひな型にデータが入った状態で上書きされちゃった」
うわー、これ、本当によくある!
そして、ひな型が上書きされると非常に困ることも良くある。
処理の途中で行を追加したり削除したりしてる場合などは最悪!
(このサンプルでは問題ないけど。)

上書きされる原因は、処理の途中で何らかのエラーが出て止まってしまった場合、ひな型をうっかり上書き保存しちゃった、がほとんどだと思う。あのフロッピーマークは無意識に押してしまう。

コード作成中にもあり得るし、運用中にもあり得る。(自分以外の人が使う場合は絶対落ちないコードを書かなくちゃいけないけど、それは今は置いておこう)
そうなると、舌打ちしながらひな型を元に戻す作業が生じる。

そんな場合の解決法は
①ひな型をコピーする(作業ブック)
 FileCopy コピー元ブック名, コピー先ブック名
②作業ブックを開いて処理する
③途中、要所要所で作業ブックを上書き保存
④作業ブックを閉じる
⑤作業ブックを削除
 Kill ファイル名

エクセルを開いて作業してるときに勝手にできるテンポラリーファイルみたいなイメージかな?(ちょっと違う?)

作業ブックを使って処理しているので、途中エラーで止まってしまっても元のひな型はそのままなので安心。
正常に終了していれば、作業ブックは削除されているので、作業ブックが存在していたら、何かしらエラーで止まったことが分かる。さらに要所要所で保存しているので、自分以外の人が使った場合、エラーの場所が推測がしやすくなる。

Sub 注文書作成_2()

    
    '作業用ブックの名前は「作業用年月日時分秒.xlsx」にする
    Dim tmp As String
    tmp = "\作業用" & Format(Now, "yyyyddmmhhnnss") & ".xlsx"

    '注文書ひな型をコピーして作業ブックを作成する
    FileCopy ThisWorkbook.Path & "\注文書ひな型.xlsx", ThisWorkbook.Path & tmp
    

    Dim wb As Workbook
    Dim ws As Worksheet
    
    '作業用ブックを開く
    Set wb = Workbooks.Open(ThisWorkbook.Path & tmp)
    Set ws = wb.Worksheets("ひな型")
    
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        
        Dim strName As String
        strName = Cells(i, 2).Value
        
        '途中ポイントごとに作業ブックを保存する
        wb.Save
        
        'リストのデータを作業用ブックに転記
        ws.Range("C5").Value = strName '名前
        ws.Range("C10").Value = Cells(i, 1).Value '日付
        ws.Range("D10").Value = Cells(i, 3).Value '品名
        ws.Range("E10").Value = Cells(i, 4).Value '金額
        
        'ブックを別名で保存
        wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx"
        
        wb.Save
        
    Next i
    
    wb.Close
    
    '作業ブックを削除
    Kill ThisWorkbook.Path & tmp

End Sub

どうでしょうか?