• 締切済み

納品書をExcelVBAで作成したいです。

初めて質問いたします。 ExcelVBAマクロで納品書を作成使用と思っております。 シートは納品一覧というシートとSetting(開始行を設定するシート)と納品書の雛形シートの3つがあります。 納品一覧シートに納品書番号、発行日、納品日、販売店、商品、重量、数量、単価、金額(金額は自動計算)を入力。 Seettingシートは開始行と使用済み納品書番号(使用済み番号は自動で入ります。) 納品書雛形はA5サイズで9品まで表示することができます。 下記のようなコードを作成しましたが、ご質問したい事があります。 Option Explicit Const Maxrow = 10000 '共通変数定義 Public wsData As Worksheet '納品データを入れる変数 Public wsRiminder As Worksheet '納品書雛形 Public wsSetting As Worksheet 'セッティング用シート Public RowsData As Long '納品データの行 Public NouhinNum As Long '納品書番号 Public r, rr, r1, r2, r_to As Integer 'for文用カウンター Public previousCilient As String Public clientname As String 'シート初期化 Sub clear_Sheet() wsRiminder.Rows("15:23").Hidden = False '隠れている行を再表示する。 wsRiminder.Range("B15:X23").Value = "" '納品書の項目、数量、単価の部分を初期化 End Sub Sub Copy_Sheet() wsRiminder.Copy before:=wsRiminder '納品書雛形をコピーする ActiveSheet.Name = NouhinNum 'シート名を納品番号にする。 Set wsRiminder = ActiveSheet 'シートをコピーすると新しくできたシートがアクティブになる。 End Sub Sub Create_Riminder(r1, r2) '請求書作成 wsRiminder.Cells(2, 30).Value = NouhinNum '納品書番号 wsRiminder.Cells(3, 30).Value = wsData.Cells(r1, 2).Value '発行日 wsRiminder.Cells(4, 30).Value = wsData.Cells(r1, 3).Value '納品日 wsRiminder.Cells(6, 1).Value = wsData.Cells(r1, 4).Value '顧客名 r_to = 15 '納品書の項目名の最初の行番号 For r = r1 To r2 With wsRiminder .Cells(r_to, 2).Value = wsData.Cells(r, 5).Value '商品名 .Cells(r_to, 20).Value = wsData.Cells(r, 6).Value '重量 .Cells(r_to, 24).Value = wsData.Cells(r, 7).Value ' 数量 .Cells(r_to, 28).Value = wsData.Cells(r, 8).Value '単価 r_to = r_to + 1 End With Next wsData.Cells(r2, 10).Value = "済" End Sub Sub Createlist_Riminder(r1, r2) '請求書の項目の部分のみ作成 For r = r1 To r2 With wsRiminder .Cells(r_to, 2).Value = wsData.Cells(r, 5).Value '商品名 .Cells(r_to, 20).Value = wsData.Cells(r, 6).Value '重量 .Cells(r_to, 24).Value = wsData.Cells(r, 7).Value ' 数量 .Cells(r_to, 28).Value = wsData.Cells(r, 8).Value '単価 r_to = r_to + 1 End With Next wsData.Cells(r2, 10).Value = "済" End Sub Sub Process_Riminder() Dim BlnRtn As Boolean Set wsData = ActiveWorkbook.Worksheets("納品一覧") Set wsSetting = ActiveWorkbook.Worksheets("Setting") Set wsRiminder = ActiveWorkbook.Worksheets("納品書雛形") RowsData = wsData.Cells(Rows.Count, 2).End(xlUp).Row 'リストの最終行番号を取得 NouhinNum = wsSetting.Cells(2, 1).Value 'for文用カウンターの定義(r1=2行目から始める,r2はリストの行数) r1 = wsSetting.Cells(2, 1).Value r2 = r1 + 1 Do While Len(Trim(wsData.Cells(r1, 4).Value)) <> 0 And wsData.Cells(r1, 9).Value <> "済" '会社名が空欄ではない場合ループする previousCilient = wsData.Cells(r1 - 1, 4).Value clientname = wsData.Cells(r1, 4).Value If wsData.Cells(r1, 9).Value <> "済" Then 'リストが作成済みになっていないもの '会社名によって初期設定される雛形シートが違う If wsData.Cells(r1, 1).Value <> wsData.Cells(r1 - 1, 1).Value Then '納品書番号が次の行と違うとき NouhinNum = wsData.Cells(r1, 1).Value For r = r1 To r2 - 1 Call clear_Sheet '雛形シートを初期化 現在の納品書の雛形ですと9品までしか表示できないので 9品以上ある場合は別途納品内訳書というシートを作成してそこに商品名、重量、数量、単価、金額を表示するようにしたいのですが、どのように組めばいいかイメージがわきません。 どうかお力添えいただけないでしょうか。

この投稿のマルチメディアは削除されているためご覧いただけません。
noname#211938
noname#211938

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

こんな長いVBAコードを質問コーナーに載せて、読者は読んでどうせよというのか。 会社の業務なのだから、本来システム設計の会社に相談すべきようなことだ。 もっとどうしたいのか文章で伝えるべきでしょう。 もっと構想(帳票設計)段階の問題だろう。 下記案ではどうですか。後続の回答者の参考のために、質問に補足したほうがよいと思う。 帳票というものは記載件数(行数)に限度があり、10件前後しか記載できないのは当たり前。 だからそんなことは覚悟して、超えたら別葉に印刷するのが当たり前だろう。 ーー ただ別途納品内訳書を作ると、様式も、印字作業も、封入作業も、プログラムも2種類になりすっきりしないのではないか。 9件(行)を超えたら、プログラムで察知できるのだから、1ページ印刷(PrintOut)して、印刷エリアデータをクリアし、ページ数を+1する。、納品先は同じ。行ポインターは 最初行へセット。 請求書を1枚ずつ、切り離した後は、同名請求先の複数ページ分の請求者はまとめて(この作業は必要)は同じ封筒に封入する。 その際、帳票が続きで出るように、データを納品先でソートしたものを使えばよい。 1枚のシートに、何枚もの納品書を詰め込んで設計している場合は、データをセットするロジックがやや複雑になるが大したことはない。 ーー >Seettingシートは開始行と使用済み納品書番号( がなぜ必要なのか理解できなかった。 ユーザーフォームで聞くとか、最低MessageBoxで聞けば済むのではないのか。

noname#211938
質問者

補足

回答ありがとうございます。 申し訳ございません。 以前別の質問をした時に、ソースコードもわからないのにイメージだけで回答はできないとの回答をいただいたことがあり、 その時の回答者様のとおり長いソースコードを載せてしまいました。 このプログラムは個人で作成しています。 用途は友人からの依頼なので私も帳票関係は詳しくなく、友人のイメージをただエクセルで完結するように起こしただけです。 画像の帳票もネットにあるテンプレートです。 メッセージボックスが出ることを好まない方なのでメッセージボックスは極力使うなと言われています。 そのためのセッティングシートです。 やはり帳票は行数の限界があるんですね。 プログラミングは授業で習った程度と個人で簡単に使う程度しか組んだことしかありません。 友人ともう一度帳票をしっかり勉強して再度質問したいと思います。 ありがとうございました。

回答No.1

> 9品以上ある場合は別途納品内訳書というシートを作成してそこに > 商品名、重量、数量、単価、金額を表示するようにしたい やりたいことはわかっているのですよね? 何がわからないのか伝えないと、回答得られませんよ。

noname#211938
質問者

補足

やりたいことはわかっているのですが、プログラムとしてそう組めばいいかがわからないのですがそういう時はどう伝えたらいいのでしょうか。

関連するQ&A

  • ExcelVBAテキストでの疑問

    Option Explicit Sub 請求書作成(Kokyaku As String) '引数「Kokyaku」は請求書を作成する顧客名 ここだけなぜ「請求書作成」、引数を宣言するのかが不明です。    Dim i As Integer '「販売」ワークシートの表の処理用カウンタ変数 Dim Cnt As Integer '請求書のワークシートの表の処理用変数 Cnt = 12 '請求書のワークシートの表の先頭行(12行目)の値に初期化 'ワークシート「請求書雛形」を末尾にコピー Worksheets("請求書雛形").Copy After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Kokyaku 'ワークシート名を設定 Worksheets(Kokyaku).Range("A6").Value = Kokyaku '請求書の宛先を設定 Worksheets(Kokyaku).Range("E2").Value = Date '請求書の発行日を設定 '指定した顧客の販売データを請求書へコピー For i = 4 To 32 If Worksheets("販売").Cells(i, 2).Value = Kokyaku Then Worksheets(Kokyaku).Cells(Cnt, 1).Value = Worksheets("販売").Cells(i, 1).Value '日付 Worksheets(Kokyaku).Cells(Cnt, 2).Value = Worksheets("販売").Cells(i, 3).Value '商品 Worksheets(Kokyaku).Cells(Cnt, 3).Value = Worksheets("販売").Cells(i, 4).Value '単価 Worksheets(Kokyaku).Cells(Cnt, 4).Value = Worksheets("販売").Cells(i, 5).Value '数量 Worksheets(Kokyaku).Cells(Cnt, 5).Value = Worksheets("販売").Cells(i, 6).Value '金額 Cnt = Cnt + 1 '請求書のワークシートの表のコピー先の行を1つ進める End If Next i End Sub Sub フォーム用意() myForm.Show End Sub

  • QNo.2826776の質問の続き 表から別シートに一覧表を作成したいのですが

    質問の続きになってしまうのですが sheet1からsheet2へ転記するVBA Private Sub Worksheet_Change(ByVal Target As Range) Sheets("Sheet2").Cells.ClearContents Sheets("Sheet2").Cells(1, 1).Value = "日付" Sheets("Sheet2").Cells(1, 2).Value = "応援に行く人" Sheets("Sheet2").Cells(1, 3).Value = "応援をもらう店舗" r2 = 1 For r = 2 To Range("A65536").End(xlUp).Row For c = 2 To 256 If Cells(r, c) <> "" Then r2 = r2 + 1 Sheets("Sheet2").Cells(r2, 1).Value = Sheets("Sheet1").Cells(r, 1) Sheets("Sheet2").Cells(r2, 2).Value = Sheets("Sheet1").Cells(1, c) Sheets("Sheet2").Cells(r2, 3).Value = Sheets("Sheet1").Cells(r, c) End If Next c Next r End Sub と教えていただきました。 もうひとつ条件を入れたいのですが「"休"を無視する」 座標やシート名の入れ替えは理解できたのですが、やはり難しく ここを頼ってしまいました。教えてください。よろしくお願いします。

  • マクロ 一覧からシートを作成する

    いつも回答して頂き、とても感謝しています。 似た様な質問を過去にしていますが、 前回の質問は、一列にシート名が記載しており、これを参照してシートを次々と挿入するマクロの作り方でしたが、今回は、複数列にシート名が記載されている場合のマクロ記述についてです。 自分なりに考えてみましたが、set = s の値がNOTHINGになり、挿入したシートに名前を記載する事ができませんでした。原因がさっぱり分からないので御教授の程宜しくお願い致します。 Sub シートの挿入() Dim s As Worksheet Dim r As Long Dim c As Long On Error GoTo errhandle c = 2 With Worksheets("作業名一覧") For r = 2 To .Cells(Rows.Count, c).End(xlUp).Row Do While .Cells(r, c).Value <> "" Set s = Worksheets(Cells(r, c).Value) c = c + 1 Loop Next r End With Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Cells(r, c).Value Worksheets(h.Value).Cells.ColumnWidth = 1 Worksheets(h.Value).Cells.RowHeight = 15 Resume End Sub

  • Excel VBAの「FOR~NEXT関数」について

    VBAを初めて2ヶ月の超初心者です。 シートが2枚あり、sheet1は仕入金額一覧、sheet2は送付案内書になっています。VBAを利用して「sheet1から1行、sheet2へ転記し印刷後、次の行へ」と言う処理をしています。 Sub 送付案内() Dim 行番号 As Integer For 行番号 = 5 To 298 If Cells(行番号, 15).Value = 1 Then Range(Cells(行番号, 2), Cells(行番号,12).Select Selection.Copy Sheets("送付案内").Select Range(Cells(60, 1), Cells(60, 11)).Select ActiveSheet.Paste Application.CutCopyMode = False Worksheets("送付案内").PrintOut Sheets("作業").Select End If Next End Sub Sub 仕入先名() Dim 行番号 As Integer For 行番号 = 5 To 298 Sheets("作業").Cells(行番号, 2) = WorksheetFunction.VLookup(Cells(行番号, 1), Sheets("仕入先マスタ"). _ Range("$A$3:$B$1135"), 2, False) Next End Sub これでVBAを実行した場合、仕入金額一覧の並び順と微妙(2~3点)に異なる順番で印刷されました。仕入先名や仕入金額に間違いはありませんでした。 同様の経験のある方等、原因がわかる方がいらしたら、教えてください。よろしくお願いします。

  • VBA For~Next 

    「wsData」の値を「wsInv」の指定セル(=●●●=16)から4つおきに処理したい。 01:Cells(16 + i * 4, 1) とすると「i」が大きいときに   「""」があると16からスタートしない 02:「For k = 0 To 50」を作成したが、何処に入れても上手く処理出来ない。 For i = 0 To 50 '行 For j = 6 To 28 '列 If wsData.Cells(10 + i, 3).Value = "" Then wsInv.Cells(●●●, 1).Value = wsData.Cells(10 + i, 1).Value wsInv.Cells(●●●, j - 2).Value = wsData.Cells(10 + i, 23 + j).Value End If Next j Next i お力添えをお願いいたします。

  • ExcelVBAで添付ファイルをつけたいです。

    Excelで顧客のアドレス帳を作成しており、そのアドレス帳全員に同じ文面でメールを送信したいと思い、マクロを作成しております。 調べながらここまではきたのですが、添付ファイルが着きません。 お手数ですが、どなたか自身のデスクトップ上にあるフォルダ内のPDFを 全メールに添付する方法を教えて頂けますでしょうか。 実行しようとすると「添付できるのは、ファイルかオブジェクトに限られます。」と出てしまいます。 ご教示の程、宜しくお願い致します。 下記書いたコードです。 Sub 自動送信Sample() Dim OL As Outlook.Application Dim MI As Outlook.MailItem Dim R_Start As Integer, R_End As Integer Dim Tenp1 As String, Tenp2 As String Set OL = CreateObject("Outlook.Application") Tenp1 = Worksheets("Sheet1").Range("B4") '添付1 Tenp2 = Worksheets("Sheet1").Range("B5") '添付2 R_Start = Worksheets("Sheet1").Range("G2") + 7 '開始番号(開始行) R_End = Worksheets("Sheet1").Range("I2") + 7 '終了番号(終了行) For R_Start = R_Start To R_End Set MI = OL.CreateItem(olMailItem) MI.SentOnBehalfOfName = Worksheets("Sheet1").Range("B2") '差出人 MI.Subject = Worksheets("Sheet1").Range("B3") '件名 MI.To = Worksheets("Sheet1").Cells(R_Start, "B") 'To MI.CC = Worksheets("Sheet1").Cells(R_Start, "C") 'CC MI.BCC = Worksheets("Sheet1").Cells(R_Start, "D") 'BCC '添付 If Tenp1 <> "" Then MI.Attachments.Add Tenp1 End If If Tenp2 <> "" Then MI.Attachments.Add Tenp2 End If '本文 MI.Body = Worksheets("Sheet1").Cells(R_Start, "E") & vbCr _ & Worksheets("Sheet1").Cells(R_Start, "F") & vbCr & vbCr _ & Worksheets("Sheet2").Range("A3") MI.Display 'メール表示 Next Set OL = Nothing Set MI = Nothing MsgBox "完了!" End Sub

  • エクセルVBA!(COPY) Win2000,offce2000

    単純な質問かもしれませんが、 WorkBooks("test")から 別のWorkBooks("Data").WorkSheets("Sheet1")のデータの数を判定して全てをコピーして、 WorkBooks("test")のWorkSheets("Sheet2")へペーストしたいのですが、うまくいきません ↓のような感じです。 Dim wstest As Worksheet Dim wsData As Worksheet Dim wsNM As String Dim Drow As Long Sub copy() 'DataSheetのSheet名がその都度違うので、取得しました。 wsNM = wsData.Sheets(1).Name Set wsData = Workbooks("Data.xls").Worksheets(wsNM) Set wsTest = Workbooks("Test.xls").WorkSheets("Sheet2") 'データの範囲判定 Drow = wsData.Range("H65536").End(xlUp).Row '/////// ここからが???です /////// wsDataのA1からBAのDrowを範囲を指定して、Copy → wsTestのA1に貼り付けたいのですが、どうしたらよいのでしょうか? コピーしたり、直接書くようにしたりといろいろなコードを書いてみましたがダメでした。 Cellsで範囲をとる方法がわかりません。Rangeなら(A1:BA300)のように取れる範囲もCellsの時はどうしたらよいのでしょうか?(そのまま書けば、Cells(1,1):Cells(Drow,53)みたいな・・・・・) と、悩んでいるより一気にコピーするのもどうかと思いFor~Nextで1行ずつ書いていったらどうかとも考えましたが、うまくいきませんでした。 End Sub ※ Drowは、6000~20000 よろしくお願いします。

  • エクセル マクロ 教えてください。

    sheet1に (a1=No. b1=月日 C1=項目 d1=収入 e1=支出 f1=摘要 G1=店名)項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。 本当に良いですか? ", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub

  • エクセル2003にて指定されたシートを複写するには?(2)

    エクセル2003にて指定されたシートを複写するには?(2) 同じ件で投稿してすみません。エクセル本を読んでも、ネットで探しても 丸2日進んでいないので、投稿させて頂きました。 以前、以下のURLで投稿したものです。 http://okwave.jp/qa/q5930740.html 【回答して頂いた内容】 Sub aaa() Dim Ws1 As Worksheet, Ws2 As Worksheet Set Ws1 = Worksheets("シート1") Set Ws2 = Worksheets("シート2") Dim Endrow As Long, r As Integer Endrow = Ws1.Cells(Rows.Count, 1).End(xlUp).Row For r = 1 To Endrow     Worksheets.Add After:=Worksheets(Worksheets.Count)    ActiveSheet.Name = Ws1.Cells(r, 1).Value    Cells(5, 1).Value = Ws1.Cells(r, 1).Value    Cells(5, 2).Value = Ws1.Cells(r, 2).Value    Cells(5, 3).Value = Ws1.Cells(r, 3).Value Next r Set Ws1 = Nothing Set Ws2 = Nothing End Sub と、ご回答を頂き、想定していた対応が出来ていますが、 問題が2つほどございます。 (1)ひとつは、シート名及びテキストをA列ではなく、J列から持ってくる必要がある。 (2)もうひとつは、1行目はタイトル行なので、2行目から開始する必要がある。 この2点を解消しようと、色々数字を入れて試したのですが、改善できないので、 どなたか、是非、アドバイス・ご享受を宜しくお願い申し上げます。

  • Excelマクロ 複数の条件と範囲条件

    色々と自分でもやってみたのですがうまくいかないので教えて頂けたら嬉しいです。 添付画像の左側の様な伝票番号と通し番号と商品名がふってあるシートが存在します。 同じ伝票番号内で商品に「松」もしくは「梅」が含まれているときのみ、その伝票番号の最終行に「送料」の行を追加したいです。その際に通し番号も加算したものを追加します。 これが上手く作れません。 ↓とりあえず作りかけたものの変に行が挿入されるマクロを記載します。ここからの修正でうまくいくなら修正点を教えて頂けると幸いです。 Sub 更新伝票情報() Dim lastRow As Long Dim currentRow As Long Dim currentInvoice As String Dim currentNumber As Integer ' シートの最終行を取得 lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' 初期値の設定 currentInvoice = Cells(2, 1).Value currentNumber = 1 ' 行ごとに処理 For currentRow = 2 To lastRow ' 伝票番号が変わった場合 If Cells(currentRow, 1).Value <> currentInvoice Then ' 新しい伝票番号の設定 currentInvoice = Cells(currentRow, 1).Value ' 通し番号をリセット currentNumber = 1 End If ' 商品名に「松」または「梅」が含まれる場合 If InStr(1, UCase(Cells(currentRow, 3).Value), UCase("松")) > 0 Or InStr(1, UCase(Cells(currentRow, 3).Value), UCase("梅")) > 0 Then ' 最終行の下に新しい行を挿入 Rows(currentRow + 1 & ":" & currentRow + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' 通し番号を加算し、B列を更新 Cells(currentRow + 1, 2).Value = currentNumber ' C列を「送料」に更新 Cells(currentRow + 1, 3).Value = "送料" ' 通し番号を1つ加算 currentNumber = currentNumber + 1 End If Next currentRow End Sub