AccessからボタンひとつでExcelへエクスポートし、セルへデータを挿入

見積書を作っていてどうしても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見積書へエクスポートできます。

ぜひやってみてください。

カテゴリー:
関連記事