VBA ひな型を壊さないようにするには?
こんにちは。
派犬事務員のコロ子です。
今月から「ノンプログラマーのためのスキルアップ研究会」初心者講座VBA コース6期が始まりました。講師はichihuku@VBAerさんです。コロ子は僭越ながらTA(ティーチングアシスタント)をさせて頂いてます。
TAは何度やっても勉強になる
コロ子ばっかり何度もTAやらせてもらってありがとうございます。TAは本当に何度やっても勉強になる。
ノンプロ研の講座は事前課題がかなり大量に出るけど、みんなちゃんとやってくるのがすごい。事前課題でもらった質問の解決法を書いてみます。
ひな型が上書きされちゃう問題
【課題】
元の課題はこれだけど、
atmarkit.itmedia.co.jp
説明を簡単にするためにちょっとアレンジします。
下記の書式の注文書を
リストのデータ分だけ作りたい。
【作成方法】
① 注文書ひな型を開く
② リストデータを注文書ひな型に転記する
③ 名前をつけて保存(ファイル名:注文書(名前).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
どうでしょうか?