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

1

見積書請求書作成 V2.0

メニュー(表紙)

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

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

最初はメニューのマクロから

3

このファイルのシートは 6 枚で非表示のシートはありません。

Private Sub CommandButton1_Click() Sheets("集計表").Select

End Sub

請求データを一覧集計します

Private Sub CommandButton2_Click() Sheets("DATA 見積").Select

End Sub

見積のデータを保存します

Private Sub CommandButton3_Click() Sheets("見積書").Select

End Sub

見積書です

Private Sub CommandButton6_Click() Sheets("請求書").Select

End Sub

請求書です

Private Sub CommandButton7_Click() Sheets("DATA 請求").Select

End Sub

請求データを保存します

Private Sub CommandButton9_Click() Sheets("説明書").Select

End Sub

4

5 セルの黄色が入力できるところ、新規登録や修正登録で保存できるデータです。 セルＢ３ お得意先名（敬称まで入力のこと） セルＧ５ 年月日 セルＧ１１ 消費税率（これは保存しません）。 摘要欄は 20 行で、金額欄には計算式があります。 セルＧ１４からセルＧ３３まで、数量＊単価の式 ここでのデータは「ＤＡＴＡ見積」に保存します。 Sub 書込見積新規() ' データ転記まえに必要最低限の入力があるかどうかチェック Range("G1").Select ActiveCell.FormulaR1C1 = "=DATA 見積!R[1]C[-6]+1" Range("G2").Select If MsgBox(prompt:="印刷はしましたか。登録したらデータは消えますよ。いいですか(^｡^)。", _ Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then

Exit Sub End If

Application.ScreenUpdating = False Dim message As String

'チェック

If Range("B3").Value = "" Then

message = MsgBox("お得意先名が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("G5").Value = "" Then

message = MsgBox("日付が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("C7").Value = "" Then

message = MsgBox("工事名が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("B14").Value = "" Then

message = MsgBox("摘要が入力されていません", vbYes, "入力確認") Exit Sub

End If

'すべて入力されていれば登録します。確認。

If MsgBox(prompt:="データの書き込みです。いいですか(^｡^)。", _

Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then Exit Sub

6 End If '見積書の新規保存です シート DATA 見積 の９行目以下に保存します。 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

Exit Sub End If ' 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 End Sub ' 詳細な説明は次のページから。

見積データの登録について

「見積書」のデータのセルの黄色の入力部分は「データ見積」の２行目に入るように式を設定しています。 1 行目と２行目と 8 行目は非表示にしています。 1 行目と 8 行目は分かりやすいように項目名と番号を、実際のデータはセルＢ２からセルＤＥ２まで。

7

「見積書」のセルＧ１に表示される数字がデータの登録整理番号となります。

「ＤＡＴＡ見積」に「見積書」のデータは 9 行目から順番に登録するように設定しています。

新規登録の位置は 次のマクロでセルＧ１には =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 書込行の位置決定 セルＧ１の数字に８を加算した数値が登録される行になります。 Sheets("DATA 見積").Activate '作業シート アクテイブに Range("B2:DE2").Select '登録データ範囲を指定 Selection.Copy

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

Exit Sub End If ここのＩＦからＥｎｄ ＩＦ は最初の確認です。 キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。 Application.ScreenUpdating = False 画面の変化を表示をさせないようにします。 Dim message As String

変数の宣言です 'チェック

該当セルが空白ならば、作業は終了です。 If Range("B3").Value = "" Then

message = MsgBox("お得意先名が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("G5").Value = "" Then

message = MsgBox("日付が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("C7").Value = "" Then

message = MsgBox("工事名が入力されていません", vbYes, "入力確認") Exit Sub

9 If Range("B14").Value = "" Then

message = MsgBox("摘要が入力されていません", vbYes, "入力確認") Exit Sub End If 'すべて入力されていれば登録します。確認。 セル B3 G5 C7 B14 お客様名 年月日 工事名 摘要の一行目 最低限 上記セルに 入力がなければ 保存はしません。以下の作業はしません。 If MsgBox(prompt:="データの書き込みです。いいですか(^｡^)。", _

Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then Exit Sub End If ここのＩＦからＥｎｄ ＩＦ は 2 度目の確認です。 キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。 2 度の確認作業を通過したらデータの保存です。 ''見積書の新規保存です シート DATA 見積 の９行目以下に保存します。 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

Exit Sub End If ここのＩＦからＥｎｄ ＩＦ は３度目のの確認です。 キャンセルすれば、以下の作業を実行しないでこのマクロは終了です。 くどいですが、２度ではなく 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

10 Sheets("DATA 見積").Protect シートの保護をする Application.ScreenUpdating = True MsgBox "転記終了" Sheets("見積書").Select クリア全部 サブマクロの実行になります Range("A2").Select End Sub

次は｛クリア全部｝の説明になります

見積データのクリアについて

元々のマクロは黒文字で、それに追加した説明は青色とします。 マクロの中で、頭に ' がある行は注釈文字列になり、マクロの実行には影響しません。 Sub クリア全部() '' データを消去する' Application.ScreenUpdating = False Range("A2").Select 次からの 5 行は今は利用していません。 'Dim ans As String

'ans = MsgBox("本当に消去していいですか？", vbOKCancel, "消去の確認") 'If ans = vbCancel Then

'Exit Sub 'End If ActiveSheet.Unprotect シート保護の解除 入力した黄色のセルの部分をクリアするマクロです。修正登録番号はクリアせずに残します。 '修正登録番号 ' Range("G1").Select ' Selection.ClearContents

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

12 Range("H14:H33").Select Selection.ClearContents '端数調整 Range("H12").Select Selection.ClearContents Range("A2").Select ActiveSheet.Protect シートの保護設定 End Sub 新規登録は整理番号を新しく採番しますが、修正登録は セルＧ１ の数字をそのまま利用して登録します。 マクロの内容は新規登録と全く同じになります。 Sub 書込見積修正() ' データ転記まえに必要最低限の入力があるかどうかチェック If MsgBox(prompt:="印刷はしましたか。登録したらデータは消えますよ。いいですか(^｡^)。", _ Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then

Exit Sub End If

Application.ScreenUpdating = False Dim message As String

'チェック

If Range("B3").Value = "" Then

message = MsgBox("お得意先名が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("G5").Value = "" Then

message = MsgBox("日付が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("C7").Value = "" Then

message = MsgBox("工事名が入力されていません", vbYes, "入力確認") Exit Sub

End If

If Range("B14").Value = "" Then

message = MsgBox("摘要が入力されていません", vbYes, "入力確認") Exit Sub

End If

'すべて入力されていれば登録します。確認。

13

Title:="間違いないですか。(^｡^)", Buttons:=vbOKCancel) = vbCancel Then Exit Sub End If ''見積書の修正保存です シート DATA 見積 の９行目以下に保存します。 ' 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

Exit Sub End If ' 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 End Sub

次はその他のマクロの説明になります

見積データの読込について

14 元々のマクロは黒文字で、それに追加した説明は青色とします。 マクロの中で、頭に ' がある行は注釈文字列になり、マクロの実行には影響しません。 保存してあるデータを画面上に読み込みます。 Sub 読込見積() ActiveSheet.Unprotect Dim 位置 As Integer Dim I As Integer 位置 = Sheets("見積書").Cells(1, 7).Value + 8 'セル G1 読込行の位置決定 読み込むデータは セルＧ１の修正登録番号 に ８ を加算した行のデータになります。 整理番号 得意先 年月日 工事名 取引方法 有効期限 金額 端数調整 Ｂ列 Ｃ列 Ｄ列 Ｅ列 Ｆ列 Ｇ列 Ｈ列 Ｉ列 ２ ３ ４ ５ ６ ７ ８ ９

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 行分あり、Ｂ列、Ｄ列、Ｅ列、Ｆ列分が「ＤＡＴＡ見積」のＪ列から 4 個分づつＣＫ列までの 80 個のセル に格納されているので、それを順次、「見積書」に戻します。 内 訳１ 数 量 単位 単 価 Ｊ列 Ｋ列 Ｌ列 Ｍ列 10 11 12 13 内 訳２ 数 量 単位 単 価 Ｎ列 Ｏ列 Ｐ列 Ｑ列 14 15 16 17

15 内 訳 20 数 量 単位 単 価

ＣＨ列 ＣＩ列 ＣＪ列 ＣＫ列 86 87 88 89 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 ＣＬ列からから 20 個分には「見積書「のＨ列のデータが入っています。これは、このファイルを作成する 前のバージョンの｛ 見積請求管理 v1.1｝を改変して、このファイルを作成したからで、若干整合性には欠けます が、「ＤＡＴＡ見積」の 1 行目、2 行目のシート変更を簡単にするための方便です。 CL 列の後に追加した備考欄の分として、最後の一行分のマクロが前の部分と違います。 ActiveSheet.Protect Range("A2").Select Sheets("見積書").Select End Sub 次のマクロはデータを次々に読み込むマクロです。 ｛ 見積請求管理 v1.1｝では、読込にも一々確認を必要としました。 今回にはありません。 セルＧ１に応じたデータが呼び込まれます。 ''修正登録番号 G1 に 1 を加算し データを読み込む 'Sub 表示_次 data 見積() Range("G1").Value = Range("G1").Value + 1 読込見積 End Sub '修正登録番号 G1 が 1 ならば前はない '修正登録番号 G1 に 1 を減算し データを読み込む Sub 表示_前 data 見積() If Range("G1").Value = 1 Then Exit Sub End If Range("G1").Value = Range("G1").Value - 1

16 読込見積 End Sub 画面の 1 枚印刷するマクロです。 '印刷用マクロ Sub 印刷_表示頁() '選択画面のシートを 1 枚印刷する Application.ScreenUpdating = False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Range("A4").Select End Sub 見積書のデータを利用して請求書を作成する。 このファイルを作成の目的が、このマクロになります。 「見積書」のデータを「請求書」に転記（送る）ものです。 データのの位置関係すべて同じです。 Sub 複写() Dim I As Integer

Sheets("請求書").Cells(3, 2).Value = Sheets("見積書").Cells(3, 2).Value セルＢ３ 得意先様 Sheets("請求書").Cells(5, 7).Value = Sheets("見積書").Cells(5, 7).Value セルＧ５ 年月日 Sheets("請求書").Cells(7, 3).Value = Sheets("見積書").Cells(7, 3).Value セルＣ７ 工事名称 Sheets("請求書").Cells(8, 3).Value = Sheets("見積書").Cells(8, 3).Value セルＣ８ 取引方法 Sheets("請求書").Cells(9, 3).Value = Sheets("見積書").Cells(9, 3).Value セルＣ９ 有効期限 Sheets("請求書").Cells(12, 8).Value = Sheets("見積書").Cells(12, 8).Value セルＨ１２ 端数調整 For I = 1 To 20 '摘要 20 行分

Sheets("請求書").Cells(14 + (I - 1), 2).Value = Sheets("見積書").Cells(14 + (I - 1), 2).Value Ｂ列摘要 Sheets("請求書").Cells(14 + (I - 1), 4).Value = Sheets("見積書").Cells(14 + (I - 1), 4).Value Ｄ列数量 Sheets("請求書").Cells(14 + (I - 1), 5).Value = Sheets("見積書").Cells(14 + (I - 1), 5).Value Ｅ列単位 Sheets("請求書").Cells(14 + (I - 1), 6).Value = Sheets("見積書").Cells(14 + (I - 1), 6).Value Ｆ列単価 Sheets("請求書").Cells(14 + (I - 1), 8).Value = Sheets("見積書").Cells(14 + (I - 1), 8).Value Ｇ列備考 Next I

Sheets("請求書").Select End Sub

次は請求書の説明になります

17

見積書と請求書はデータ関係は全て同じ位置で いくつかの文言が変わっているだけです。

「見積書」のデータは「ＤＡＴＡ見積」に登録保存されます

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

次は DATA 見積・DATA 請求の説明になります

ＤＡＴＡ見積、ＤＡＴＡ請求のマクロについて

19 「DATA 見積」 元々のマクロは黒文字で、それに追加した説明は青色とします。

マクロの中で、頭に ' がある行は注釈文字列になり、マクロの実行には影響しません。

Private Sub CommandButton3_Click() クリア一行 1

End Sub

Private Sub CommandButton2_Click() クリア DATA End Sub 元々のマクロは黒文字で、それに追加した説明は青色とします。 マクロの中で、頭に ' がある行は注釈文字列になり、マクロの実行には影響しません。 Sub クリア DATA() '' Macro1 Macro Application.ScreenUpdating = False Dim ans As String

MsgBox "全部のデータの消去です。よく考えて実行しましょう。"

ans = MsgBox("すべてのデータを本当に消去していいですか？", vbOKCancel, "消去の確認") If ans = vbCancel Then

Exit Sub End If ActiveSheet.Unprotect Range("B9:CK1008").Select Selection.ClearContents Range("A4").Select

20 ActiveSheet.Protect End Sub '「ＤＡＴＡ見積」用 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 '現在のシートの名前 下の５行はプログラム作成時点で、変数の確認するためのチェック用のもの。 完成後は削除しても良いのですが、削除しないで注釈文字列にしています。 ' MsgBox R1 ' MsgBox "B" & R1

' MsgBox "D" & R1 & ":I" & R1 ' MsgBox Sn ' Stop 注意のメッセージの表示 MsgBox "データの消去には、十分注意が必要です。" ＩＦ ＥｎｄＩｆ が 2 重になっています。 If R1 < 9 Or Sn <> "DATA 見積" Then '8 行以下やシート名のチェック MsgBox "この行のデータは消去できません", 0 + 48, "確認" 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 列に設置 End If End If End Sub 「ＤＡＴＡ請求」用 Sub クリア一行 2() 'カーソルのある行のデータを消去します。 Dim R1 As Integer

21 Dim C1 As Integer Dim Sn As String R1 = ActiveCell.Row '現在のセルの位置の行番号 C1 = ActiveCell.Column '現在のセルの位置の列番号 Sn = ActiveSheet.Name '現在のシートの名前 下の５行はプログラム作成時点で、変数の確認するためのチェック用のもの。 完成後は削除しても良いのですが、削除しないで注釈文字列にしています。 ' MsgBox R1 ' MsgBox "B" & R1

' MsgBox "D" & R1 & ":I" & R1 ' MsgBox Sn ' Stop MsgBox "データの消去には、十分注意が必要です。" If R1 < 9 Or Sn <> "DATA 請求" Then '8 行以下やシート名のチェック MsgBox "この行のデータは消去できません", 0 + 48, "確認" 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 列に設置 End If End If End Sub

次は請求金額一覧の集計の説明になります

22

請求金額一覧集計について

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

MsgBox "データがありません。" Exit Sub

23 End If データがあれば作業が続きます。無い場合は以上で作業は終了です。 Application.ScreenUpdating = False 'DATA 請求から 年月日、伝票№ 、得意先、 金額、工事名を転記 ActiveSheet.Unprotect 作業の前にシートの保護を解除します。シート「集計表」ですね。 Sheets("DATA 請求").Select Range("B9:E1008").Select Ｂ列・整理番号 Ｃ列・得意先 Ｄ列・年月日 Ｅ列・工事名 Selection.Copy 選択範囲をコピー Sheets("集計表").Select Range("C6").Select セルＣ６を先頭にして、値のみを貼り付ける（Ｃ列からＦ列までに） Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

: =False, Transpose:=False Application.CutCopyMode = False コピーモードの解除 Sheets("DATA 請求").Select Range("H9:H1008").Select Ｈ列・工事金額 Selection.Copy 選択範囲をコピー Sheets("集計表").Select Range("G6").Select セルＧ６を先頭にして、値のみを貼り付ける（Ｇ列） 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 この並べ替えはエクセル２００３で作成のものです。 'Ｂ６の式をデータ分だけコピー ＝MONTH(E6) Ｂ列にＥ列の年月日から月のみを取り出します。 Dim su As Integer 変数宣言 su = Range("B2").Value 'セルＢ２にデータ数のカウント式設置 =COUNTA(E:E) データの数だけオートフィルコピーするためです Range("B6").Select Selection.Copy

24 Range("B7:B" & su + 4).Select

ActiveSheet.Paste Application.CutCopyMode = False Range("A2").Select ActiveSheet.Protect End Sub ' 'Sub 年間集計() ' データが無い場合には作業が終了します。 If Cells(6, 3).Value = 0 Then

MsgBox "データがありません。" Exit Sub End If データが有る場合には、カーソルをＢ５において ここを基準にして 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 End Sub '小計の設定画面です ' 小計の設定画面の中のすべて削除を実行すると、下のマクロになります。

25 Sub 年間解除()

' If Cells(6, 4).Value = 0 Then

MsgBox "データがありません。" Exit Sub End If ActiveSheet.Unprotect Range("B5").Select Selection.RemoveSubtotal Range("A2").Select ActiveSheet.Protect End Sub セルＢ６にはコピー元の式があります。ここを残して Ｂ６からＩ１００５までの範囲をクリアするものです。 Sub 年間クリア()

' If Cells(6, 3).Value = 0 Then

MsgBox "データがありません。" Exit Sub End If ActiveSheet.Unprotect Range("B7:I1005").Select Selection.ClearContents Range("C6:G6").Select Selection.ClearContents Range("A2").Select ActiveSheet.Protect End Sub Ｂ６の式をコピー方式ではない別の方法でやれば、ここは１回で済みます。 Range("B6:I1005").Select Selection.ClearContents ここだけに限らず、同じ作業をするいくつかの方法があります。したがってマクロも色々な記述方法があります。 このファイルの例で言えば、 6 ページの請求へ複写のマクロは式で入力していますが、昔の私ならば、セルをコピーして値のみ貼り付けで データの数だけ実行して下のようになっていたと思います。

以上でファイルの説明は終了です。

どんな形の見積書や請求書でもこの応用で作成できるのではないでしょうか