Top> よくつかうプログラム> メイクショップ納品書

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

メイクショップ納品書

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

目的

メイクショップを使ってショッピングモールを運営する。
市場をショッピングモールにするために店をカテゴリーに登録する。
各店が地図また店のボタンをクリックするとその店(カテゴリー)のショップにリンクするホームページを作成しておく。

問題点

納品書の送り先が代表1カ所のため、店(カテゴリー)のショップごとの納品書が発行できない。

大きな流れ

メイクショップから出力された受注データをCSV形式でエクセルに取り込む

メイクショップ納品書

メイクショップから出力された受注データを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

ポイント:複数行毎でページが変わるのでコード変化時の処理の部品を参考にする

 

 

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)