再利用して保存する場合は新規登録ボタン 1000 件まで登録できます読み込んだ見積もりデータを請求書に送るときは請求へ複写ボタン 2 請求書の作成請求書ボタンを押し必要な項目を入力し印刷新規登録ボタン data 読込ボタンで作成済みデータを読みこめます登録修正番号の数値の

Size: px

Start display at page:

Download "再利用して保存する場合は新規登録ボタン 1000 件まで登録できます読み込んだ見積もりデータを請求書に送るときは請求へ複写ボタン 2 請求書の作成請求書ボタンを押し必要な項目を入力し印刷新規登録ボタン data 読込ボタンで作成済みデータを読みこめます登録修正番号の数値の"

くうしょうかせ
5 years ago
Views:

1 見積書請求書作成 V2.0 メニュー ( 表紙 ) このメニューにあるボタンのマクロはシートへの移動マクロですこのファイルを利用する場合にはシートの保護を解除しないでくださいデータの削除や移動はしないでくださいファイルが壊れます見積請求作成平成 25 年 7 月作業の流れは 1 見積書の作成見積書ボタンを押し必要な項目を入力し印刷新規登録ボタン data 読込ボタンで作成済みデータを読みこめます登録修正番号の数値の DATA 見積のデータです次前ボタンでも直接数字を打ち込んでも良いです読み込んだデータを修正して保存する場合は修正登録ボタン 1

2 再利用して保存する場合は新規登録ボタン 1000 件まで登録できます読み込んだ見積もりデータを請求書に送るときは請求へ複写ボタン 2 請求書の作成請求書ボタンを押し必要な項目を入力し印刷新規登録ボタン data 読込ボタンで作成済みデータを読みこめます登録修正番号の数値の DATA 請求のデータです次前ボタンでも直接数字を打ち込んでも良いです読み込んだデータを修正して保存する場合は修正登録ボタン再利用して保存する場合は新規登録ボタン 1000 件まで登録できます 3 書類作成画面ではクリアは 2 種類あります全内容をクリアするものと工事名称金額等をクリアするものセル B3 G5 C7 B14 お客様名年月日工事名摘要の一行目最低限上記セルに入力がなければ保存はしません一度登録したデータの削除はできません年度別に利用した場合の集計のために間違ったデータを計算させないため一部消去のマクロは準備しています小計と合計小計が必要な場合は空白行を設けその摘要欄に金額等を入力します金額欄には入力表示はできませんこのファイルのデータは 1000 件まで登録保存できますが年単位で利用するほうが良いでしょう古いものはそのまま残しておいて新規に名前をつけて保存します 2 本の同じファイルができます新しい名前のファイルのシート DATA 見積とシート DATA 請求の全データを消去してから利用します集計台帳は請求書の発行一覧表を作成するものです転記と集計のあと必要に応じて印刷しますその後解除とクリアをしますデータが 1 件でもあれば実行できます ( 意味はないですね ) 月別の集計ですので数ヶ月間データが蓄積されると意味が出てきますここでの作業の前にファイル保存をしてくださいここでの作業でファイルがおかしくなったら上書き保存はしないことそのファイルは保存しないで終了前のファイルを再度読み込みましょう集計は2 度はしないこと解除をしないうちにクリアをしないこと最初はメニューのマクロから 2

3 このファイルのシートは 6 枚で非表示のシートはありません Private Sub CommandButton1_Click() Sheets(" 集計表 ").Select Private Sub CommandButton2_Click() Sheets("DATA 見積 ").Select Private Sub CommandButton3_Click() Sheets(" 見積書 ").Select Private Sub CommandButton6_Click() Sheets(" 請求書 ").Select Private Sub CommandButton7_Click() Sheets("DATA 請求 ").Select Private Sub CommandButton9_Click() Sheets(" 説明書 ").Select 請求データを一覧集計します見積のデータを保存します見積書です請求書です請求データを保存します説明書です 3

4 見積書について 4

5 セルの黄色が入力できるところ新規登録や修正登録で保存できるデータですセルB3 お得意先名 ( 敬称まで入力のこと ) セルG5 年月日セルG11 消費税率 ( これは保存しません ) 摘要欄は 20 行で金額欄には計算式がありますセルG14からセルG33まで数量 * 単価の式ここでのデータは DATA 見積に保存します Sub 書込見積新規 () ' データ転記まえに必要最低限の入力があるかどうかチェック Range("G1").Select ActiveCell.FormulaR1C1 = "=DATA 見積!R[1]C[-6]+1" Range("G2").Select If MsgBox(prompt:=" 印刷はしましたか登録したらデータは消えますよいいですか (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then Application.ScreenUpdating = False Dim message As String ' チェック If Range("B3").Value = "" Then message = MsgBox(" お得意先名が入力されていません ", vbyes, " 入力確認 ") If Range("G5").Value = "" Then message = MsgBox(" 日付が入力されていません ", vbyes, " 入力確認 ") If Range("C7").Value = "" Then message = MsgBox(" 工事名が入力されていません ", vbyes, " 入力確認 ") If Range("B14").Value = "" Then message = MsgBox(" 摘要が入力されていません ", vbyes, " 入力確認 ") ' すべて入力されていれば登録します確認 If MsgBox(prompt:=" データの書き込みですいいですか (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then 5

6 ' 見積書の新規保存です Application.ScreenUpdating = False Sheets("DATA 見積 ").Unprotect Dim 位置 As Integer シート DATA 見積の 9 行目以下に保存します位置 = Sheets(" 見積書 ").Cells(1, 7).Value + 8 ' セル C1 書込行の位置決定 If MsgBox(prompt:="DATA 見積への " & 位置 - 8 & " 行目への保存ですメモをお勧めします (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then ' Application.ScreenUpdating = False Sheets("DATA 見積 ").Activate ' 作業シートアクテイブに Range("B2:DE2").Select ' 登録データ範囲を指定 Selection.Copy Range("B" & 位置 ).Select ' 値のみ貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A7").Select Application.CutCopyMode = False Sheets("DATA 見積 ").Protect Application.ScreenUpdating = True MsgBox " 転記終了 " Sheets(" 見積書 ").Select クリア全部 Range("A2").Select ' 詳細な説明は次のページから見積データの登録について見積書のデータのセルの黄色の入力部分はデータ見積の 2 行目に入るように式を設定しています 1 行目と 2 行目と 8 行目は非表示にしています 1 行目と 8 行目は分かりやすいように項目名と番号を実際のデータはセル B2 からセル DE2 まで 6

見積書のセルG1に表示される数字がデータの登録整理番号となります DATA 見積に見積書のデータは 9 行目から順番に登録するように設定しています新規登録の位置は次のマクロでセルG1には =DATA 見積!A2+1 という式が入力されます DATA 見積!A2 には =COUNT(B9:B1008) の式があるのでいまあるデータの次の番号になります Range("G1").

7 見積書のセルG1に表示される数字がデータの登録整理番号となります DATA 見積に見積書のデータは 9 行目から順番に登録するように設定しています新規登録の位置は次のマクロでセルG1には =DATA 見積!A2+1 という式が入力されます DATA 見積!A2 には =COUNT(B9:B1008) の式があるのでいまあるデータの次の番号になります Range("G1").Select ActiveCell.FormulaR1C1 = "=DATA 見積!R[1]C[-6]+1" Range("G2").Select データの保存のマクロです 2 行目のデータをすでにあるデータの次の行に値のみ貼付けをします Dim 位置 As Integer 位置 = Sheets(" 見積書 ").Cells(1, 7).Value + 8 ' セル C1 書込行の位置決定セルG1の数字に8を加算した数値が登録される行になります Sheets("DATA 見積 ").Activate ' 作業シートアクテイブに Range("B2:DE2").Select ' 登録データ範囲を指定 Selection.Copy Range("B" & 位置 ).Select ' 値のみ貼り付け 7

8 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A7").Select Application.CutCopyMode = False 全体のマクロは次のとおりです元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません Sub 書込見積新規 () ' データ転記まえに必要最低限の入力があるかどうかチェック Range("G1").Select ActiveCell.FormulaR1C1 = "=DATA 見積!R[1]C[-6]+1" Range("G2").Select If MsgBox(prompt:=" 印刷はしましたか登録したらデータは消えますよいいですか (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then ここのIFからEnd IF は最初の確認ですキャンセルすれば以下の作業を実行しないでこのマクロは終了です Application.ScreenUpdating = False 画面の変化を表示をさせないようにします Dim message As String 変数の宣言です ' チェック該当セルが空白ならば作業は終了です If Range("B3").Value = "" Then message = MsgBox(" お得意先名が入力されていません ", vbyes, " 入力確認 ") If Range("G5").Value = "" Then message = MsgBox(" 日付が入力されていません ", vbyes, " 入力確認 ") If Range("C7").Value = "" Then message = MsgBox(" 工事名が入力されていません ", vbyes, " 入力確認 ") 8

9 If Range("B14").Value = "" Then message = MsgBox(" 摘要が入力されていません ", vbyes, " 入力確認 ") ' すべて入力されていれば登録します確認セル B3 G5 C7 B14 お客様名年月日工事名摘要の一行目最低限上記セルに入力がなければ保存はしません以下の作業はしません If MsgBox(prompt:=" データの書き込みですいいですか (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then ここのIFからEnd IF は 2 度目の確認ですキャンセルすれば以下の作業を実行しないでこのマクロは終了です 2 度の確認作業を通過したらデータの保存です '' 見積書の新規保存ですシート DATA 見積の9 行目以下に保存します Application.ScreenUpdating = False 画面表示の変化を表示させない Sheets("DATA 見積 ").Unprotect シートの保護を解除する Dim 位置 As Integer 変数の宣言です位置 = Sheets(" 見積書 ").Cells(1, 7).Value + 8 ' セル C1 書込行の位置決定 If MsgBox(prompt:="DATA 見積への " & 位置 - 8 & " 行目への保存ですメモをお勧めします (^ ^) Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then ここのIFからEnd IF は3 度目のの確認ですキャンセルすれば以下の作業を実行しないでこのマクロは終了ですくどいですが 2 度ではなく 3 度目の確認作業を通過したらデータの保存です Application.ScreenUpdating = False Sheets("DATA 見積 ").Activate ' 作業シートアクテイブに Range("B2:DE2").Select ' 登録データ範囲を指定 Selection.Copy Range("B" & 位置 ).Select ' 値のみ貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ : =False, Transpose:=False Range("A7").Select データが下の行に貼付けられました Application.CutCopyMode = False 9

10 Sheets("DATA 見積 ").Protect シートの保護をする Application.ScreenUpdating = True MsgBox " 転記終了 " Sheets(" 見積書 ").Select クリア全部サブマクロの実行になります Range("A2").Select 次は { クリア全部 } の説明になります見積データのクリアについて元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません Sub クリア全部 () '' データを消去する ' Application.ScreenUpdating = False Range("A2").Select 次からの 5 行は今は利用していません 'Dim ans As String 'ans = MsgBox(" 本当に消去していいですか?", vbokcancel, " 消去の確認 ") 'If ans = vbcancel Then ' ' ActiveSheet.Unprotect シート保護の解除入力した黄色のセルの部分をクリアするマクロです修正登録番号はクリアせずに残します ' 修正登録番号 ' Range("G1").Select ' 10

11 ' 年月日 Range("G5").Select ' 得意先 Range("B3").Select ' 取引方法有効期限 Range("C8:C9").Select ' 工事名 Range("C7:D7").Select ' 摘要 Range("B14:F33").Select ' 備考 Range("H14:H33").Select ' 端数調整 Range("H12").Select Range("A2").Select ActiveSheet.Protect ' ついでに次のマクロまで得意先などは残して工事内容金額をクリアするマクロです Sub クリア工事 () '' データを消去する Application.ScreenUpdating = False Range("A2").Select ActiveSheet.Unprotect シートの保護解除 ' 工事名 Range("C7:D7").Select ' 摘要 Range("B14:F33").Select ' 備考 11

12 Range("H14:H33").Select ' 端数調整 Range("H12").Select Range("A2").Select ActiveSheet.Protect シートの保護設定新規登録は整理番号を新しく採番しますが修正登録はセルG1 の数字をそのまま利用して登録しますマクロの内容は新規登録と全く同じになります Sub 書込見積修正 () ' データ転記まえに必要最低限の入力があるかどうかチェック If MsgBox(prompt:=" 印刷はしましたか登録したらデータは消えますよいいですか (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then Application.ScreenUpdating = False Dim message As String ' チェック If Range("B3").Value = "" Then message = MsgBox(" お得意先名が入力されていません ", vbyes, " 入力確認 ") If Range("G5").Value = "" Then message = MsgBox(" 日付が入力されていません ", vbyes, " 入力確認 ") If Range("C7").Value = "" Then message = MsgBox(" 工事名が入力されていません ", vbyes, " 入力確認 ") If Range("B14").Value = "" Then message = MsgBox(" 摘要が入力されていません ", vbyes, " 入力確認 ") ' すべて入力されていれば登録します確認 If MsgBox(prompt:=" データの書き込みですいいですか (^ ^) ", _ 12

13 Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then '' 見積書の修正保存ですシート DATA 見積の9 行目以下に保存します ' Application.ScreenUpdating = False Sheets("DATA 見積 ").Unprotect Dim 位置 As Integer 位置 = Sheets(" 見積書 ").Cells(1, 7).Value + 8 ' セル C1 書込行の位置決定 If MsgBox(prompt:="DATA 見積への " & 位置 - 8 & " 行目への保存ですメモをお勧めします (^ ^) ", _ Title:=" 間違いないですか (^ ^)", Buttons:=vbOKCancel) = vbcancel Then ' Application.ScreenUpdating = False Sheets("DATA 見積 ").Activate ' 作業シートアクテイブに Range("B2:DE2").Select ' 登録データ範囲を指定 Selection.Copy Range("B" & 位置 ).Select ' 値のみ貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ : =False, Transpose:=False Range("A7").Select Application.CutCopyMode = False Sheets("DATA 見積 ").Protect Application.ScreenUpdating = True MsgBox " 転記終了 " Sheets(" 見積書 ").Select クリア全部 Range("A2").Select 次はその他のマクロの説明になります見積データの読込について 13

14 元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません保存してあるデータを画面上に読み込みます Sub 読込見積 () ActiveSheet.Unprotect Dim 位置 As Integer Dim I As Integer 位置 = Sheets(" 見積書 ").Cells(1, 7).Value + 8 ' セル G1 読込行の位置決定読み込むデータはセルG1の修正登録番号に 8 を加算した行のデータになります整理番号得意先年月日工事名取引方法有効期限金額端数調整 B 列 C 列 D 列 E 列 F 列 G 列 H 列 I 列 Sheets(" 見積書 ").Cells(3, 2).Value = Sheets("DATA 見積 ").Cells( 位置, 3).Value Sheets(" 見積書 ").Cells(5, 7).Value = Sheets("DATA 見積 ").Cells( 位置, 4).Value Sheets(" 見積書 ").Cells(7, 3).Value = Sheets("DATA 見積 ").Cells( 位置, 5).Value Sheets(" 見積書 ").Cells(8, 3).Value = Sheets("DATA 見積 ").Cells( 位置, 6).Value Sheets(" 見積書 ").Cells(9, 3).Value = Sheets("DATA 見積 ").Cells( 位置, 7).Value Sheets(" 見積書 ").Cells(12, 8).Value = Sheets("DATA 見積 ").Cells( 位置, 9).Value 摘要欄は 20 行分あり B 列 D 列 E 列 F 列分が DATA 見積のJ 列から 4 個分づつCK 列までの 80 個のセルに格納されているのでそれを順次見積書に戻します内訳 1 数量単位単価 J 列 K 列 L 列 M 列内訳 2 数量単位単価 N 列 O 列 P 列 Q 列

15 内訳 20 数量単位単価 CH 列 CI 列 CJ 列 CK 列 For I = 1 To 20 ' 摘要 20 行分 Sheets(" 見積書 ").Cells(14 + (I - 1), 2).Value = Sheets("DATA 見積 ").Cells( 位置, 10 + (I - 1) * 4).Value Sheets(" 見積書 ").Cells(14 + (I - 1), 4).Value = Sheets("DATA 見積 ").Cells( 位置, 11 + (I - 1) * 4).Value Sheets(" 見積書 ").Cells(14 + (I - 1), 5).Value = Sheets("DATA 見積 ").Cells( 位置, 12 + (I - 1) * 4).Value Sheets(" 見積書 ").Cells(14 + (I - 1), 6).Value = Sheets("DATA 見積 ").Cells( 位置, 13 + (I - 1) * 4).Value 'CL 列の後に追加した備考欄の分 Sheets(" 見積書 ").Cells(14 + (I - 1), 8).Value = Sheets("DATA 見積 ").Cells( 位置, 89 + I).Value Next I CL 列からから 20 個分には見積書のH 列のデータが入っていますこれはこのファイルを作成する前のバージョンの { 見積請求管理 v1.1} を改変してこのファイルを作成したからで若干整合性には欠けますが DATA 見積の 1 行目 2 行目のシート変更を簡単にするための方便です CL 列の後に追加した備考欄の分として最後の一行分のマクロが前の部分と違います ActiveSheet.Protect Range("A2").Select Sheets(" 見積書 ").Select 次のマクロはデータを次々に読み込むマクロです { 見積請求管理 v1.1} では読込にも一々確認を必要としました今回にはありませんセルG1に応じたデータが呼び込まれます '' 修正登録番号 G1 に 1 を加算しデータを読み込む 'Sub 表示 _ 次 data 見積 () Range("G1").Value = Range("G1").Value + 1 読込見積 ' 修正登録番号 G1 が 1 ならば前はない ' 修正登録番号 G1 に 1 を減算しデータを読み込む Sub 表示 _ 前 data 見積 () If Range("G1").Value = 1 Then Range("G1").Value = Range("G1").Value

16 読込見積画面の 1 枚印刷するマクロです ' 印刷用マクロ Sub 印刷 _ 表示頁 () ' 選択画面のシートを 1 枚印刷する Application.ScreenUpdating = False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Range("A4").Select 見積書のデータを利用して請求書を作成するこのファイルを作成の目的がこのマクロになります見積書のデータを請求書に転記( 送る ) ものですデータのの位置関係すべて同じです Sub 複写 () Dim I As Integer Sheets(" 請求書 ").Cells(3, 2).Value = Sheets(" 見積書 ").Cells(3, 2).Value セルB3 得意先様 Sheets(" 請求書 ").Cells(5, 7).Value = Sheets(" 見積書 ").Cells(5, 7).Value セルG5 年月日 Sheets(" 請求書 ").Cells(7, 3).Value = Sheets(" 見積書 ").Cells(7, 3).Value セルC7 工事名称 Sheets(" 請求書 ").Cells(8, 3).Value = Sheets(" 見積書 ").Cells(8, 3).Value セルC8 取引方法 Sheets(" 請求書 ").Cells(9, 3).Value = Sheets(" 見積書 ").Cells(9, 3).Value セルC9 有効期限 Sheets(" 請求書 ").Cells(12, 8).Value = Sheets(" 見積書 ").Cells(12, 8).Value セルH12 端数調整 For I = 1 To 20 ' 摘要 20 行分 Sheets(" 請求書 ").Cells(14 + (I - 1), 2).Value = Sheets(" 見積書 ").Cells(14 + (I - 1), 2).Value B 列摘要 Sheets(" 請求書 ").Cells(14 + (I - 1), 4).Value = Sheets(" 見積書 ").Cells(14 + (I - 1), 4).Value D 列数量 Sheets(" 請求書 ").Cells(14 + (I - 1), 5).Value = Sheets(" 見積書 ").Cells(14 + (I - 1), 5).Value E 列単位 Sheets(" 請求書 ").Cells(14 + (I - 1), 6).Value = Sheets(" 見積書 ").Cells(14 + (I - 1), 6).Value F 列単価 Sheets(" 請求書 ").Cells(14 + (I - 1), 8).Value = Sheets(" 見積書 ").Cells(14 + (I - 1), 8).Value G 列備考 Next I Sheets(" 請求書 ").Select 次は請求書の説明になります請求書について 16

17 見積書と請求書はデータ関係は全て同じ位置でいくつかの文言が変わっているだけです見積書のデータは DATA 見積に登録保存されます請求書のデータは DATA 請求に登録保存されます 17

請求書のマクロは見積書のマクロとほぼ同じです見積という部分を請求と変えることでそのまま利用できますので説明は省略しますここではシートの説明黄色のセルの部分は自由に入力できる部分でこのデータは登録保存できるものです青色のセルも入力可能です事業所名称等を入力します入力した金額の合計はセルG24になりますセルG24の式 =SUM(G14:G33) 消費税の額はセル11になります

18 請求書のマクロは見積書のマクロとほぼ同じです見積という部分を請求と変えることでそのまま利用できますので説明は省略しますここではシートの説明黄色のセルの部分は自由に入力できる部分でこのデータは登録保存できるものです青色のセルも入力可能です事業所名称等を入力します入力した金額の合計はセルG24になりますセルG24の式 =SUM(G14:G33) 消費税の額はセル11になりますセルH11の式 =(G34*G11) 消費税の額税率はセルG11の表示形式は下のとおり税率がアップしてもここを変更すれば使えます実際には少数があることになります税込請求金額はセルC11になりますセルC11の式 =(G34+H11+H12) セルH12 に調整額の欄値引きの欄を設けましたマイナスで入力することで値引き額を表示できます次は DATA 見積 DATA 請求の説明になります DATA 見積 DATA 請求のマクロについて 18

DATA 見積元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません Private Sub CommandButton3_Click() クリア一行 1 Private Sub CommandButton2_Click() クリア DATA 元々のマクロは黒文字でそれに追加した説明は青色とします

19 DATA 見積元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません Private Sub CommandButton3_Click() クリア一行 1 Private Sub CommandButton2_Click() クリア DATA 元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません Sub クリア DATA() '' Macro1 Macro Application.ScreenUpdating = False Dim ans As String MsgBox " 全部のデータの消去ですよく考えて実行しましょう " ans = MsgBox(" すべてのデータを本当に消去していいですか?", vbokcancel, " 消去の確認 ") If ans = vbcancel Then ActiveSheet.Unprotect Range("B9:CK1008").Select Range("A4").Select 19

20 ActiveSheet.Protect ' DATA 見積用 Sub クリア一行 1() ' カーソルのある行のデータを消去します Application.ScreenUpdating = False Dim R1 As Integer Dim C1 As Integer Dim Sn As String R1 = ActiveCell.Row ' 現在のセルの位置の行番号 C1 = ActiveCell.Column ' 現在のセルの位置の列番号 Sn = ActiveSheet.Name ' 現在のシートの名前下の5 行はプログラム作成時点で変数の確認するためのチェック用のもの完成後は削除しても良いのですが削除しないで注釈文字列にしています ' MsgBox R1 ' MsgBox "B" & R1 ' MsgBox "D" & R1 & ":I" & R1 ' MsgBox Sn ' Stop 注意のメッセージの表示 MsgBox " データの消去には十分注意が必要です " IF EndIf が 2 重になっています If R1 < 9 Or Sn <> "DATA 見積 " Then '8 行以下やシート名のチェック MsgBox " この行のデータは消去できません ", , " 確認 " Else MsgBox R1-8 & " 番目のデータの消去です " Dim ans As String ans = MsgBox(" 本当に消去していいですか?", vbokcancel, " 消去の確認 ") If ans = vbok Then ActiveSheet.Unprotect 'F 列から Range("F" & R1 & ":CK" & R1) = "" ActiveSheet.Protect Cells(R1, 1).Select ' カーソルを A 列に設置 DATA 請求用 Sub クリア一行 2() ' カーソルのある行のデータを消去します Dim R1 As Integer 20

21 Dim C1 As Integer Dim Sn As String R1 = ActiveCell.Row ' 現在のセルの位置の行番号 C1 = ActiveCell.Column ' 現在のセルの位置の列番号 Sn = ActiveSheet.Name ' 現在のシートの名前下の5 行はプログラム作成時点で変数の確認するためのチェック用のもの完成後は削除しても良いのですが削除しないで注釈文字列にしています ' MsgBox R1 ' MsgBox "B" & R1 ' MsgBox "D" & R1 & ":I" & R1 ' MsgBox Sn ' Stop MsgBox " データの消去には十分注意が必要です " If R1 < 9 Or Sn <> "DATA 請求 " Then '8 行以下やシート名のチェック MsgBox " この行のデータは消去できません ", , " 確認 " Else MsgBox R1-8 & " 番目のデータの消去です " Dim ans As String ans = MsgBox(" 本当に消去していいですか?", vbokcancel, " 消去の確認 ") If ans = vbok Then ActiveSheet.Unprotect 'F 列から Range("F" & R1 & ":CK" & R1) = "" ActiveSheet.Protect Cells(R1, 1).Select ' カーソルを A 列に設置次は請求金額一覧の集計の説明になります 21

請求金額一覧集計について NO9 元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません左側のボタンから順次実行します集計台帳は請求書の発行一覧表を作成するものです転記と集計のあと必要に応じて印刷しますその後解除とクリアをしますデータが 1 件でもあれば実行できます ( 意味はないですね )

22 請求金額一覧集計について NO9 元々のマクロは黒文字でそれに追加した説明は青色としますマクロの中で頭に ' がある行は注釈文字列になりマクロの実行には影響しません左側のボタンから順次実行します集計台帳は請求書の発行一覧表を作成するものです転記と集計のあと必要に応じて印刷しますその後解除とクリアをしますデータが 1 件でもあれば実行できます ( 意味はないですね ) 月別の集計ですので数ヶ月間データが蓄積されると意味が出てきますここでの作業の前にファイル保存をしてくださいここでの作業でファイルがおかしくなったら上書き保存はしないことそのファイルは保存しないで終了前のファイルを再度読み込みましょう集計は2 度はしないこと解除をしないうちにクリアをしないことファイルが壊れる確率は高いですぞ!(^^)! ' 年間一覧表のマクロ 'Sub 年間転記 () ' データの有無を確認請求書のデータの有無を確認します DATA 請求のセルB9 に数値があれば 1 行はデータがあることになります If Sheets("DATA 請求 ").Cells(9, 2).Value = 0 Then MsgBox " データがありません " 22

23 データがあれば作業が続きます無い場合は以上で作業は終了です Application.ScreenUpdating = False 'DATA 請求から年月日伝票得意先金額工事名を転記 ActiveSheet.Unprotect 作業の前にシートの保護を解除しますシート集計表ですね Sheets("DATA 請求 ").Select Range("B9:E1008").Select B 列整理番号 C 列得意先 D 列年月日 E 列工事名 Selection.Copy 選択範囲をコピー Sheets(" 集計表 ").Select Range("C6").Select セルC6を先頭にして値のみを貼り付ける (C 列からF 列までに ) Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ : =False, Transpose:=False Application.CutCopyMode = False コピーモードの解除 Sheets("DATA 請求 ").Select Range("H9:H1008").Select H 列工事金額 Selection.Copy 選択範囲をコピー Sheets(" 集計表 ").Select Range("G6").Select セルG6を先頭にして値のみを貼り付ける (G 列 ) Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ : =False, Transpose:=False Application.CutCopyMode = False コピーモードの解除 Range("A5").Select Sheets("DATA 請求 ").Select Range("A5").Select ' 念のため並べ替え年月日 Sheets(" 集計表 ").Select Range("C5:G1005").Select Selection.Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ : =xlpinyin, DataOption1:=xlSortNormal この並べ替えはエクセル2003で作成のものです 'B6の式をデータ分だけコピー =MONTH(E6) B 列にE 列の年月日から月のみを取り出します Dim su As Integer 変数宣言 su = Range("B2").Value ' セルB2にデータ数のカウント式設置 =COUNTA(E:E) データの数だけオートフィルコピーするためです Range("B6").Select Selection.Copy 23

Range("B7:B" & su + 4).Select ActiveSheet.Paste Application.CutCopyMode = False Range("A2").Select ActiveSheet.Protect ' 'Sub 年間集計 () ' データが無い場合には作業が終了します If Cells(6, 3).

24 Range("B7:B" & su + 4).Select ActiveSheet.Paste Application.CutCopyMode = False Range("A2").Select ActiveSheet.Protect ' 'Sub 年間集計 () ' データが無い場合には作業が終了します If Cells(6, 3).Value = 0 Then MsgBox " データがありません " データが有る場合にはカーソルをB5においてここを基準にして 6 列目の金額の月別小計を計算します ActiveSheet.Unprotect Range("B5").Select Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Range("A2").Select ActiveSheet.Protect ' 小計の設定画面です ' 小計の設定画面の中のすべて削除を実行すると下のマクロになります 24

25 Sub 年間解除 () ' If Cells(6, 4).Value = 0 Then MsgBox " データがありません " ActiveSheet.Unprotect Range("B5").Select Selection.RemoveSubtotal Range("A2").Select ActiveSheet.Protect セルB6にはコピー元の式がありますここを残して B6からI1005までの範囲をクリアするものです Sub 年間クリア () ' If Cells(6, 3).Value = 0 Then MsgBox " データがありません " ActiveSheet.Unprotect Range("B7:I1005").Select Range("C6:G6").Select Range("A2").Select ActiveSheet.Protect B6 の式をコピー方式ではない別の方法でやればここは 1 回で済みます Range("B6:I1005").Select ここだけに限らず同じ作業をするいくつかの方法がありますしたがってマクロも色々な記述方法がありますこのファイルの例で言えば 6 ページの請求へ複写のマクロは式で入力していますが昔の私ならばセルをコピーして値のみ貼り付けでデータの数だけ実行して下のようになっていたと思います以上でファイルの説明は終了ですどんな形の見積書や請求書でもこの応用で作成できるのではないでしょうか 25

PowerPoint プレゼンテーション

PowerPoint プレゼンテーション演習課題レッスン (1) '(1) ワークシートどうしのやりとり ' ワークシート請求書 1 からワークシートデータ収集にデータを転記しましょう Sub example01() ' 請求書番号 ( 請求書 1のE2からデータ収集のA2へ ) Worksheets(" データ収集 ").Range("A2").Value = Worksheets(" 請求書 1").Range("E2").Value