見積書を作っていてどうしてもAccessではなく、慣れ親しんでいるExcelで見積書を手直ししたいという方もいるかもしれないと思い、入力はAccessでしてもらいますが、Excelに落として、好きなように加工してもらえるようにAccessからボタンひとつでExcelにエクスポートできるようにVBAを作ってみました。
コードは『moug』さんのサイトを参考にさせていただき作りました。
こちらがその、エクスポートの記事です。
とてもわかりやすく書いてあるので簡単にできると思います。
今回はエクスポート部分は省略します。
エクスポートをして、エクセルを開いた時に書き込みます。
先ほどのmougさんのコードを使うとExcelのオープンも含まれていますので、これを利用して書き込みます。
それでは作ってみましょう！
まず、Accessからデータをエクスポートする専用のシートを作っておきます。
今回は『Accessシート』という名前の何も入っていないシートをExcelにあらかじめ作っておきました。
Accessからエクスポートしても横並びのデータのままでは使えません。
ここからExcelの見積書に合うように自動で書き込みするようにコードを作ります。
Excelの見積書はこんな感じです。こちらの見積書のシート名は『原本』としています。
Excelを開いた時に実行するコードを書きます。
コードはExcelを開いた時に実行するようにOpenで作っておきます。
Excelを開いた時に実行するコード
Private Sub Workbook_Open()
Set sh1 = Worksheets("原本")
Set sh2 = Worksheets("accessシート")
sh1.Range("A3").Value = sh2.Range("A2").Value '見積NO
sh1.Range("A5").Value = sh2.Range("D2").Value '得意先名
sh1.Range("B7").Value = sh2.Range("K2").Value & " " '得意先担当名
sh1.Range("B12").Value = sh2.Range("F2").Value '工事名
sh1.Range("B14").Value = sh2.Range("G2").Value '工事場所
sh1.Range("B16").Value = sh2.Range("H2").Value '受渡場所
sh1.Range("B17").Value = sh2.Range("I2").Value '納期
sh1.Range("B18").Value = sh2.Range("J2").Value '取引条件
sh1.Range("G9").Value = sh2.Range("X2").Value '代表名
sh1.Range("G10").Value = " TEL " & Left(sh2.Range("Y2"), 3) & "-" & Mid(sh2.Range("Y2"), 3, 3) & "-" & Right(sh2.Range("Y2"), 4) 'TEL
sh1.Range("G11").Value = " FAX " & sh2.Range("Z2").Value 'FAX
sh1.Range("I17").Value = sh2.Range("AA2").Value '有効期限
sh1.Range("B44").Value = sh2.Range("L2").Value '備考
sh1.Range("G6").Value = sh2.Range("W2").Value '社名
sh1.Range("B44:O48").Merge '--- B44:O48を結合
sh1.Range("G8").Value = sh2.Range("U2").Value & " " & sh2.Range("V2").Value '住所
If sh2.Range("m2") = "" Then '見積日付
sh1.Range("I4").Value = Date '空欄なら今日
Else
sh1.Range("I4").Value = sh2.Range("M2").Value '見積日
End If
Dim i As Integer '品名、規格（規格入っていないときは、・つかない）
Dim j As Integer
For i = 2 To 21
For j = 0 To 2
If sh2.Cells(i, 15) = "" Then
sh1.Cells(i + 19, 1).Value = sh2.Cells(i, 14).Value
sh1.Cells(i + 19, j + 4).Value = sh2.Cells(i, j + 16).Value
sh1.Cells(i + 19, 12).Value = sh2.Cells(i, 20).Value '定価
Else
sh1.Cells(i + 19, 1).Value = sh2.Cells(i, 14).Value & "･" & sh2.Cells(i, 15).Value
sh1.Cells(i + 19, j + 4).Value = sh2.Cells(i, j + 16).Value
sh1.Cells(i + 19, 12).Value = sh2.Cells(i, 20).Value '定価
End If
Next j
Next i
If sh1.Range("B16") = "" Then
sh1.Range("B16").Value = "ご相談の上" '受渡場所
ElseIf sh1.Range("B17") = "" Then
sh1.Range("B17").Value = "ご注文の際、再度ご確認ください" '納期
ElseIf sh1.Range("B18") = "" Then
sh1.Range("B18").Value = "当社規定による" '取引条件
End If
End Sub
こんな感じで作っているとAccessの見積検索からExcelに書き出したい見積書を指定してボタンクリックひとつでExcel見積書へエクスポートできます。
ぜひやってみてください。
ここの記事を読んだ方へおすすめの本