メイクショップ納品書印刷

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

メイクショップから出力された受注データをCSV形式でエクセルに取り込む
メイクショップから出力された受注データはユーザーのdownloadフォルダーにコピーされる。

Sub 納品書()
'メイクショップデータをエクセルへ
    Dim myFol As String
    Dim mybook As String
    myFol = "D:\AsaiDocument\asai\Downloads"
    ChDir myFol
    OpenFileName = Application.GetOpenFilename("csvファイル,*.csv")
    If OpenFileName <> "False" Then
        Workbooks.Open OpenFileName
        mybook = ActiveWorkbook.Name
        Workbooks(mybook).Close
        Call 取り込み
        Call データ作成
    End If
End Sub
作業シートにコピー

Sub 取り込み()
'メイクショップデータをエクセルへ
    Dim textline, csvline() As String
    Dim Rowcnt, ColumNum As Integer
    Dim ch1 As Long
    Worksheets("作業").Cells.Clear
    Worksheets("作業").Cells(1, 1) = "日付"
    Worksheets("作業").Cells(1, 2) = "注文者"
    Worksheets("作業").Cells(1, 3) = "注文金額"
    Worksheets("作業").Cells(1, 4) = "消費税"
    Worksheets("作業").Cells(1, 5) = "送料"
    Worksheets("作業").Cells(1, 6) = "商品名"
    Worksheets("作業").Cells(1, 7) = "個数"
    Worksheets("作業").Cells(1, 8) = "独自商品コード"
    Worksheets("作業").Cells(1, 9) = "商品価格"
    Worksheets("作業").Cells(1, 10) = "郵便番号"
    Worksheets("作業").Cells(1, 11) = "住所"
    Worksheets("作業").Cells(1, 12) = "受取人の電話番号"
    ch1 = FreeFile
    Open OpenFileName For Input As #ch1
    Rowcnt = 1
    Do While Not EOF(ch1)
        Line Input #ch1, textline
        csvline() = Split(textline, ",")
        Range(Worksheets("作業").Cells(Rowcnt, 1), _
        Worksheets("作業").Cells(Rowcnt, UBound(csvline()) + 1)) = csvline()
        Rowcnt = Rowcnt + 1
    Loop
End Sub
納品書の枚数を数え、納品書基本（空白データ）を枚数分納品書にコピーする。
コピーした納品書にデータを転記する。

Sub データ作成()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim lastRow As Long
    Dim lastRow1 As Long
    Dim kensu As Long
    Dim namae As String
    Dim uriage As Long
    Dim mcode As Long
    Dim sentou As Long
'枚数を数える（注文者か売上金額が異なれば別伝票と考える）
    namae = Worksheets("作業").Cells(2, 2)
    uriage = Worksheets("作業").Cells(2, 3)
    kensu = 1
    lastRow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        If namae <> Worksheets("作業").Cells(i, 2) Or uriage <> Worksheets("作業").Cells(i, 3) Then
           kensu = kensu + 1
        End If
        namae = Worksheets("作業").Cells(i, 2)
        uriage = Worksheets("作業").Cells(i, 3)
    Next
'枚数分の空白納品書を作成する
    Worksheets("納品書").Cells.Clear
    Worksheets("納品書基本").Select
    Worksheets("納品書基本").Rows("1:55").Select
    Selection.Copy
    Sheets("納品書").Select
    For i = 1 To kensu
        Cells(1 + (i - 1) * 55, 1).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
    Next
'納品書にデータを転記
    namae = Worksheets("作業").Cells(2, 2)
    uriage = Worksheets("作業").Cells(2, 3)
    j = 0
    l = 0
    sentou = 1
    For i = 2 To lastRow
        If namae <> Worksheets("作業").Cells(i, 2) Or uriage <> Worksheets("作業").Cells(i, 3) Then
            j = j + 55
            sentou = 1
            l = 0
        End If
   
'同じ納品書の間の転記
            If sentou = 1 Then
                Worksheets("納品書").Cells(2 + j, 5) = Worksheets("作業").Cells(i, 1)
                mcode = Worksheets("作業").Cells(i, 8)
                lastRow1 = Worksheets("店").Cells(Rows.Count, 1).End(xlUp).Row
            '店
                For k = 2 To lastRow1
                    If mcode = Worksheets("店").Cells(k, 1) Then
                       Worksheets("納品書").Cells(6 + j, 4) = "544-0031"
                       Worksheets("納品書").Cells(7 + j, 4) = Worksheets("店").Cells(k, 3)
                       Worksheets("納品書").Cells(8 + j, 4) = Worksheets("店").Cells(k, 2)
                       Worksheets("納品書").Cells(9 + j, 4) = Worksheets("店").Cells(k, 4)
                       Worksheets("納品書").Cells(10 + j, 4) = "VBAネット市場『VBA実践塾』"
                    End If
                Next
'送り先
                Worksheets("納品書").Cells(4 + j, 2) = Worksheets("作業").Cells(i, 10)
                Worksheets("納品書").Cells(5 + j, 2) = Worksheets("作業").Cells(i, 11)
                Worksheets("納品書").Cells(6 + j, 2) = Worksheets("作業").Cells(i, 2) & "様"
                Worksheets("納品書").Cells(7 + j, 2) = Worksheets("作業").Cells(i, 12)
                sentou = 0
            End If
'明細
            Worksheets("納品書").Cells(15 + j + l, 2) = Worksheets("作業").Cells(i, 6)
            Worksheets("納品書").Cells(15 + j + l, 3) = Worksheets("作業").Cells(i, 7)
            Worksheets("納品書").Cells(15 + j + l, 4) = Worksheets("作業").Cells(i, 9)
            Worksheets("納品書").Cells(15 + j + l, 5) = Worksheets("作業").Cells(i, 7) * Worksheets("作業").Cells(i, 9)
            l = l + 1
        mcode = Worksheets("作業").Cells(i, 8)
        namae = Worksheets("作業").Cells(i, 2)
        uriage = Worksheets("作業").Cells(i, 3)
    Next
End Sub
ポイント：複数行毎でページが変わるのでコード変化時の処理の部品を参考にする