前回の「見積書の雛形をエクセルVBAで作ろう！（Part 6）」ではセルの結合をしてから文字を入力し、大きさや配置などを調整して見積書の形が出来上がりました。
今回はこの見積書にロゴマークと角印を挿入して見栄えを良くしたいと思います。
ロゴマークの画像を挿入する
今日書き込む部分もまた独立したSubプロシージャにしておきましょう。
名前は「ロゴマークの画像を挿入する」にしましょうか。 ↓
ロゴマークを挿入するということは、当然ですが挿入するロゴマークを用意しなくてはなりません。
ですのでこの見積書に挿入する画像ファイルを２つ用意しました。
ひとつは会社名ロゴの代わりにこのブログサイトのロゴマーク、もうひとつは社印の代わりのこのブログサイトの角印です。
このリンクをクリックして２つのファイルをダウンロードしてください。
・ロゴマークのファイル
・角印のファイル
ダウンロードしたらその２つのファイルを今使っている「VBA練習１」のエクセルファイルと同じフォルダに保存してください。 このファイルを見積書に挿入していきます。
まずはいつも通り変数の宣言です。以下の5つの変数を作りましょう。
Dim F As String '画像ファイルのパス（データ型は文字列型のString） Dim R As Range '挿入したい位置（セルで指定）（データ型はオブジェクト型のRange） Dim W As Variant '画像の横幅指定ポイント値（データ型はバリアント型のVariant） Dim S As Object '挿入した画像シェイプ（データ型はオブジェクト型のObject） Dim N As String '画像につける名前（データ型は文字列型のString）
やろうとしている事は、今使っているエクセルブック「VBA練習１」と同じフォルダ内に入っている画像ファイル「benkyo_room_banner468x60.png」を位置を指定して挿入し、挿入した画像の名前変更、大きさ変更です。
画像を挿入する方法は２つあるそうで、
ひとつはPictures.Insertメソッド、もう一つはShapes.AddPictureメソッドを使う方法です。
前者はリンク貼り付けしか出来ない為、画像ファイルの位置が変わるとリンク切れで画像が表示されなくなってしまいます。 それでは困るので後者のShapes.AddPictureメソッドを使います。
4つの変数に代入していきましょう。 ↓
F = ThisWorkbook.Path & "\benkyo_room_banner468x60.png" '画像ファイルのパス Set R = Range("D2") '挿入したい位置（セルで指定） W = Range("D2:H2").Width '画像の横幅指定ポイント値 N = "ロゴ" '画像につける名前
黄色で塗ったThisWorkbookは今使っているエクセルブックです。
その数あるプロパティのうち「.Pass」（ブックがあるフォルダのフルパス）を利用し、
貼り付ける画像ファイル名benkyo_room_banner468x60.pngの先頭に￥を付けた文字列をくっつけて変数Fに代入しました。
変数Rはデータ型がRangeなので代入するときは先頭にSetをつけています。
変数Wには画像の横幅ポイント値を代入しました。セル範囲D2：H2に横幅を合わせたいのでその.Widthプロパティを利用しています。
最後は変数Nに画像につける名前を文字列で代入しています。
変数の代入が終わったので今度は画像を挿入しましょう。 ↓
'画像を挿入 Set S = ActiveSheet.Shapes.AddPicture( _ Filename:=F, _ linktofile:=msoFalse, _ savewithdocument:=msoTrue, _ Left:=R.Left, _ Top:=R.Top, _ Width:=-1, _ Height:=-1) S.Name = N '画像の名前を設定 S.LockAspectRatio = msoTrue '画像の縦横比を固定 S.Width = W '画像の横幅を設定
Shapes.AddPictureメソッド構文は７つの引数を指定しなければならず横にとても長いので、視認性を良くする為に途中で半角スペースとアンダーバーを入れて改行をしています。
引数の書き方は以下の通り。
Filename:= 挿入するファイル名をフルパスで指定
linktofile:= 画像を元のファイルにリンクするかmsoFalseかmsoTrueで指定
savewithdocument:= ブックを保存する時に画像を含めるかをmsoTrueかmsoFalseで指定
Left:= ワークシートの左端を基準にして画像の左端の位置をポイント値で指定
これは挿入したい位置にあるセルのLeftプロパティ（左端のポイント値）を利用
Top:= ワークシートの上端を基準にして画像の上端の位置をポイント値で指定
これは挿入したい位置にあるセルのTopプロパティ（上端のポイント値）を利用
Width:= 画像の横幅をポイント値で指定（元の大きさを維持するには-1を指定）
Height:= 画像の高さをポイント値で指定（元の大きさを維持するには-1を指定）
これらの引数をカンマで区切り、カッコで囲って指定します。
そしてこの挿入した画像を変数Sに代入しました。Set S = を取ってしまうとうまく動かなくなってしまいます。その理由は、、すいません私にはまだ判りません。。
そして代入した変数Sを使って画像の名前を変更し、画像の縦横比を固定、最後に画像の横幅を変更します。 いずれもオブジェクト（画像シェイプ）のもつ数あるプロパティのうち
「.Name」（名前）に変数Nを代入
「.LockAspectRatio」（縦横比の固定）をmsoTrueで固定し（固定しない場合はmsoFalse）
「.Width」（横幅ポイント値）に変数Wを代入しています。
全部合わせるとこうなります。 ↓
Sub ロゴマークの画像を挿入する()
Dim F As String '画像ファイルのパス（データ型は文字列型のString）
Dim R As Range '挿入したい位置（セルで指定）（データ型はオブジェクト型のRange）
Dim W As Variant '画像の横幅指定ポイント値（データ型はバリアント型のVariant）
Dim S As Object '挿入した画像シェイプ（データ型はオブジェクト型のObject）
Dim N As String '画像につける名前（データ型は文字列型のString）
F = ThisWorkbook.Path & "\benkyo_room_banner468x60.png"
'画像ファイルのパス
Set R = Range("D2") '挿入したい位置（セルで指定）
W = Range("D2:H2").Width '画像の横幅指定ポイント値
N = "ロゴ" '画像につける名前
'画像を挿入
Set S = ActiveSheet.Shapes.AddPicture( _
Filename:=F, _
linktofile:=msoFalse, _
savewithdocument:=msoTrue, _
Left:=R.Left, _
Top:=R.Top, _
Width:=-1, _
Height:=-1)
S.Name = N '画像の名前を設定
S.LockAspectRatio = msoTrue '画像の縦横比を固定
S.Width = W '画像の横幅を設定
End Sub動作テストをしてみましょう。 ↓
書き間違えがなければセルD2とH2の間の位置にロゴマークが入ったはずです。
そして挿入したロゴマークを選択すると、左上に表示される名前が「ロゴ」になったのが確認できると思います。 ↓
角印の画像を挿入する
次は角印を挿入しましょう。 やり方は全く同じですのでファイル名と挿入位置、横幅、名前を指定し直してみましょう。 新しいSubを作ってからやってみてください。 ↓
Sub 角印の画像を挿入する() Dim F As String '画像ファイルのパス（データ型は文字列型のString） Dim R As Range '挿入したい位置（セルで指定）（データ型はオブジェクト型のRange） Dim W As Variant '画像の横幅指定ポイント値（データ型はバリアント型のVariant） Dim S As Object '挿入した画像シェイプ（データ型はオブジェクト型のObject） Dim N As String '画像につける名前（データ型は文字列型のString） F = ThisWorkbook.Path & "\benkyo_room_kakuinn2000x2000.gif" '画像ファイルのパス Set R = Range("H10") '挿入したい位置（セルで指定） W = Range("H10").Width '画像の横幅指定ポイント値 N = "角印" '画像につける名前 ' 画像を挿入 Set S = ActiveSheet.Shapes.AddPicture( _ Filename:=F, _ linktofile:=msoFalse, _ savewithdocument:=msoTrue, _ Left:=R.Left, _ Top:=R.Top, _ Width:=-1, _ Height:=-1) S.Name = N '画像の名前を設定 S.LockAspectRatio = msoTrue '画像の縦横比を固定 S.Width = W '画像の横幅を設定 End Sub
出来たらまたSubの中にカーソルを置いてからテストしてみてください。 書き間違えがなければ角印がセルH10の所に角印が挿入されるはずです。こうなったでしょうか。 ↓
これで見積書の形が出来上がりました！
セルに計算式を入れる
やはりエクセルなのですから数式もいれておきたいですよね。
それぞれの行の「金額」欄に計算式をいれて、「合計」「消費税」「税込み価格」「御見積り金額」の各欄にも計算式をいれていきましょう。
セルに計算式を入れる場合は複数の表現方法がありますが、そこは検索していただいて他のブログサイトなどで勉強してみてください。 ここでは.Valueプロパティに代入していくやり方で書いていきます。
セルに値を入れる場合はRangeオブジェクトの「.Value」プロパティに値を代入します。
たとえばVBEに Range(“C1”) .Value = “あいうえお”
と書けばC1セルに「あいうえお」と書けます。
この.Valueは省略しても構いません。Rangeオブジェクトのプロパティが省略された場合は、自動で.Valueを指定した事になります。 ですから Range(“C1”) = “あいうえお” でOKです。
では手書きで数式をセルに書く場合はみなさんどうしてますか？
先頭にイコール（＝）を書いてから数式を書いていきますよね。たとえば =A1+B1 のように。
そうするとエクセルは先頭にイコール（＝）がついている事で数式だと判断して動作してくれます。
VBAで Range(“C1”) = “=A1+B1″ と書いても同じ動作をしてくれます。
「.Value」プロパティに入ってきた値の先頭にイコール（＝）がついている事で数式だと判断して「.Formula」（数式）プロパティなどに入れ直してくれます。
ということは、「金額」欄に式を入れたい場合はこうなりますかね。
Range(“G21”) = “=IF(D21=””,””,ROUNDUP(D21*F21,0))“
IF関数をいれてD21の「数量」欄が空欄の時は「金額」欄も空欄にして
ROUNDUP関数をいれて「金額」欄に端数が出たときには繰り上げて整数にしています。
ただ、この式にはVBAで数式を文字列として書く場合、直さなければならない事があります。
IF関数の中に入っているダブルクォーテーション（”）です。
VBAでは文字列を代入する場合は、これまでやってきた通りダブルクォーテーション（”）で囲います。 この文字列として囲われた範囲内にさらにダブルクォーテーション（”）の囲いが入ってくると、「文字列の囲い」が複数出来てしまい、「代入したい文字列の囲い」が混乱します。
そこで代入する「文字列の囲い」の中にさらにダブルクォーテーション（”）の囲いを入れる場合は「その囲い」の外側をさらにダブルクォーテーション（”）で囲うという決まりがあります。
この式でいうと、空欄を入れるための「””」の囲いをさらにダブルクォーテーション（”）で囲う事になるので Range(“G21”) = “=IF(D21=““”“,““”“,ROUNDUP(D21*F21,0))” と書き直します。
前回の「見積書の雛形をエクセルVBAで作ろう！（Part 6）」でのコード作成の時にはこの決まりを知らず、だいぶハマりました。この決まりは重要です。覚えておきましょう。
さあ、この決まりを踏まえて数式を代入していきます。
「金額」欄に数式をいれますが、G21からG32まで同じですから、一括で入力しましょう。
複数セルに一括で入力する場合はエクセルが自動で相対参照のフィルをかけてくれます。
Range(“G21:G32”) = “=IF(D21=””””,””””,ROUNDUP(D21*F21,0))”
あとは簡単ですから一気に書いてしまいましょうか。 ↓
Sub 計算式を入れる()
Range("G21:G32") = "=IF(D21="""","""",ROUNDUP(D21*F21,0))" '「金額」欄に数式を代入
Range("H34") = "=SUM(G21:G32)" '「合計」欄に数式を代入
Range("H35") = "=ROUNDDOWN(H34*0.1,0)" '「消費税」欄に数式を代入
Range("H36") = "=SUM(H34:H35)" '「税込み価格」欄に数式を代入
Range("B13") = "=H36" '「御見積り金額」欄に数式を代入
End Sub文字列の先頭にイコール（＝）をつけるのをお忘れなく。 書き間違えがなければ数式が入ったはずです。 ↓
印刷時のページ設定
数式も入りましたので今度は印刷する時にきちんと配置されるように下記の設定をおこないましょう。
Sub 印刷時のページ設定()
With ActiveSheet.PageSetup 'With構文で繰り返し部分を省略する
.PrintArea = "A1:I43" '印刷範囲の設定
.CenterHorizontally = True '水平方向でページ中央に配置
.Zoom = False '拡大、縮小率を「指定しない」
.FitToPagesWide = 1 '横方向１ページで印刷
.FitToPagesTall = False '縦方向はページ数を「指定しない」
End With
End Sub「PageSetup」オブジェクトの数あるプロパティの中から
.PrintArea （印刷範囲の設定）
.CenterHorizontally （水平方向でページ中央に配置）
.Zoom （拡大、縮小率の設定）
.FitToPagesWide （横方向に収めるページ数）
.FitToPagesTall （縦方向に収めるページ数）
を使って設定しました。
ここで初めてWith構文が出てきました。
繰り返し記述する部分がある場合は、このWith構文を使うと文字数を減らす事が出来て見やすくなります。
With の後ろに「繰り返したい部分」を書き、改行してその後の構文を書きます。
今回の例では「ActiveSheet.PageSetup」を繰り返し書かなければならなかったので、Withの後ろに入れました。繰り返す構文が終わったらEnd Withと書いてWith構文を終わらせます。
こうなりましたでしょうか。 ↓
最後にCallで各Subプロシージャを呼び出す記述を追加する
最後の仕上げです。 ここまででSubプロシージャを１０個作ってきました。
・Sub 新規ブックで見積書雛形の作成()
・Sub 列幅を配列を使って変更する()
・Sub 行高さを配列を使って変更する()
・Sub 罫線を引く()
・Sub セルの結合をする()
・Sub 文字を入れて調整する()
・Sub ロゴマークの画像を挿入する()
・Sub 角印の画像を挿入する()
・Sub 計算式を入れる()
・Sub 印刷時のページ設定()
これらのSubプロシージャをテストするとき、それぞれのSub ～ End Subの間にカーソルを置いてからテストしてもらっていました。つまりそれぞれのSubプロシージャはEnd Subに到達すると終了します。 順番に動かしたいですからCallステートメントを使って各Subプロシージャを呼び出します。
最初に作った「Sub 新規ブックで見積書雛形の作成()」を見てください。 ↓
Sub 新規ブックで見積書雛形の作成()
' 新規ブックを作成する
Workbooks.Add
' 先頭のシート名を変更する
Worksheets(1).Name = "見積書表紙"
End SubこれにCallステートメントを使って各Subプロシージャを呼び出す記述を追記します。 ↓
Sub 新規ブックで見積書雛形の作成()
' 新規ブックを作成する
Workbooks.Add
' 先頭のシート名を変更する
Worksheets(1).Name = "見積書表紙"
' 各Subプロシージャを呼び出す
Call 列幅を配列を使って変更する
Call 行高さを配列を使って変更する
Call 罫線を引く
Call セルの結合をする
Call 文字を入れて調整する
Call ロゴマークの画像を挿入する
Call 角印の画像を挿入する
Call 計算式を入れる
Call 印刷時のページ設定
End Sub上記のようにCallのあとに呼び出すプロシージャ名だけを書き、Subや()は書きません。
これでこの「Sub 新規ブックで見積書雛形の作成()」が各Subプロシージャを呼び出して実行させてくれます。 ↓
これで見積書雛形作成の標準モジュールが出来上がりました！ ↓
Option Explicit
Sub 新規ブックで見積書雛形の作成()
' 新規ブックを作成する
Workbooks.Add
' 先頭のシート名を変更する
Worksheets(1).Name = "見積書表紙"
' 各Subプロシージャを呼び出す
Call 列幅を配列を使って変更する
Call 行高さを配列を使って変更する
Call 罫線を引く
Call セルの結合をする
Call 文字を入れて調整する
Call ロゴマークの画像を挿入する
Call 角印の画像を挿入する
Call 計算式を入れる
Call 印刷時のページ設定
End Sub
Sub 列幅を配列を使って変更する()
' 変数の宣言
Dim rng As Range 'セルまたは列（データ型はオブジェクト型のRange）
Dim pt As Variant 'ポイント値（データ型はバリアント型のVariant）
Dim mojisu As Single '変換後の文字数（データ型は単精度浮動小数点数型のSingle）
Dim i As Long '列番号（データ型は長整数型のLong）
Dim N As Long '3回繰り返し用のカウンター（データ型は長整数型）
pt = Array(5, 27.5, 303.5, 57, 42.5, 80, 80, 94, 5) 'ポイント値を配列で代入
For i = 1 To 9
For N = 1 To 3
Set rng = Columns(i) 'セルまたは列を設定
mojisu = pt(i - 1) * (rng.ColumnWidth / rng.Width) '設定する文字数を代入
rng.ColumnWidth = mojisu '列幅を変換後の文字数で設定
Next N
Next i
End Sub
Sub 行高さを配列を使って変更する()
' 変数の宣言
Dim rng As Range 'セルまたは行（データ型はオブジェクト型のRange）
Dim pt As Variant 'ポイント値（配列で格納）（データ型はバリアント型のVariant）
Dim i As Long '行番号（データ型は長整数型のLong）
pt = Array(5, 52.5, 19.5, 18.5, 18.5, 18.5, 18.5, 18.5, 18.5, 18.5, 18.5, _
18.5, 18.5, 18, 18.5, 18.5, 18, 7.5, 18.5, 4.5, 37.5, 37.5, 37.5, 37.5, 37.5, _
37.5, 37.5, 37.5, 37.5, 37.5, 37.5, 37.5, 18.5, 18, 18, 18.5, 18, 18, 18, 18, _
18, 18.5, 5) 'ポイント値を配列で代入
For i = 1 To 43
Set rng = Rows(i) 'セルまたは行を設定
rng.RowHeight = pt(i - 1) '行高さを変数ptの配列番号を指定して代入
Next i
End Sub
Sub 罫線を引く()
Dim Bs As Borders '罫線プロパティの集合体（コレクション）
'（データ型はオブジェクト型のBorders）
Dim B As Border '罫線プロパティ
'（データ型はオブジェクト型のBorder）
Dim C As Long 'RGB関数の値（データ型は長整数型のLong）
C = RGB(0, 112, 192) '青色を代入
Set B = Range("B2:H2").Borders(xlEdgeBottom)
B.Weight = xlThick
B.Color = C
Set B = Range("B5:D5").Borders(xlEdgeBottom)
B.Weight = xlMedium
B.Color = C
Range("B7:D7").Borders(xlEdgeBottom).Color = C
Range("B9:D11").BorderAround LineStyle:=xlContinuous
Set Bs = Range("B9:D11").Borders
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
Range("B13:D14").BorderAround LineStyle:=xlContinuous
Set Bs = Range("B13:D14").Borders
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
Range("B19:H19").Borders.Color = C
Range("B21:H32").Borders.Color = C
Range("G34:H36").Borders.Color = C
Range("B37:H42").Borders(xlInsideHorizontal).Color = C
Set Bs = Range("B19:H19").Borders
Bs(xlEdgeTop).Weight = xlMedium
Bs(xlEdgeBottom).Weight = xlMedium
Bs(xlEdgeLeft).Weight = xlMedium
Bs(xlEdgeRight).Weight = xlMedium
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
Set Bs = Range("B20:H36").Borders
Bs(xlEdgeTop).Weight = xlMedium
Bs(xlEdgeBottom).Weight = xlMedium
Bs(xlEdgeLeft).Weight = xlMedium
Bs(xlEdgeRight).Weight = xlMedium
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
Set Bs = Range("G34:H36").Borders
Bs(xlEdgeTop).Weight = xlMedium
Bs(xlEdgeBottom).Weight = xlMedium
Bs(xlEdgeLeft).Weight = xlMedium
Bs(xlEdgeRight).Weight = xlMedium
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
Set Bs = Range("B37:H42").Borders
Bs(xlEdgeTop).Weight = xlMedium
Bs(xlEdgeBottom).Weight = xlMedium
Bs(xlEdgeLeft).Weight = xlMedium
Bs(xlEdgeRight).Weight = xlMedium
Bs(xlEdgeTop).Color = C
Bs(xlEdgeBottom).Color = C
Bs(xlEdgeLeft).Color = C
Bs(xlEdgeRight).Color = C
End Sub
Sub セルの結合をする()
Application.DisplayAlerts = False '確認メッセージを非表示
Range("B2:C2").Merge 'セル範囲を結合
Range("B4:D5").Merge 'セル範囲を結合
Range("B7:D7").Merge 'セル範囲を結合
Range("B9:D11").Merge 'セル範囲を結合
Range("B12:D12").Merge 'セル範囲を結合
Range("B13:D14").Merge 'セル範囲を結合
Range("B15:D17").Merge True 'セル範囲を行ごとに結合
Range("G6:H7").Merge 'セル範囲を結合
Range("G8:H9").Merge True 'セル範囲を行ごとに結合
Range("F11:H12").Merge 'セル範囲を結合
Range("F13:H13").Merge 'セル範囲を結合
Range("G14:H14").Merge 'セル範囲を結合
Range("F15:H16").Merge 'セル範囲を結合
Range("B38:H42").Merge True 'セル範囲を行ごとに結合
Application.DisplayAlerts = True '確認メッセージを表示
End Sub
Sub 文字を入れて調整する()
Dim R As Range 'セル（データ型はオブジェクト型のRange）
Set R = Range("B2:H42") '変数Rにセルを代入
R.Font.Size = 11 'フォントサイズを代入
R.Font.Bold = False '太字に変更
R.VerticalAlignment = xlCenter '縦中央揃えに変更
R.HorizontalAlignment = xlLeft '左寄せに変更
R.IndentLevel = 0 'インデントを0に変更
R.WrapText = False '折返しする
R.NumberFormatLocal = "@" 'セルの表示形式
Set R = Range("B2") '変数Rにセルを代入
R.Value = "御 見 積 書" '値を代入
R.Font.Size = 22 'フォントサイズを代入
R.Font.Bold = True '太字に変更
R.Font.Color = RGB(0, 112, 192) '文字色を青色に変更
R.VerticalAlignment = xlBottom '下揃えに変更
R.IndentLevel = 1 'インデントを１に変更
Set R = Range("B4") '変数Rにセルを代入
R.Value = "〇〇〇〇〇株式会社 御中" '値を代入
R.Font.Size = 14 'フォントサイズを代入
R.VerticalAlignment = xlBottom '下揃えに変更
R.IndentLevel = 1 'インデントを１に変更
R.WrapText = True '折返しする
Set R = Range("B7") '変数Rにセルを代入
R.Value = "ご担当者 様" '値を代入
R.Font.Size = 14 'フォントサイズを代入
R.IndentLevel = 1 'インデントを１に変更
Set R = Range("B9") '変数Rにセルを代入
R.Value = "〇〇〇案件" '値を代入
R.Font.Size = 14 'フォントサイズを代入
R.IndentLevel = 1 'インデントを１に変更
R.WrapText = True '折返しする
Set R = Range("B12") '変数Rにセルを代入
R.Value = "下記の通り御見積り申し上げます。" '値を代入
R.IndentLevel = 1 'インデントを１に変更
Set R = Range("B13") '変数Rにセルを代入
R.NumberFormatLocal = """御見積り金額： ""#,##0""円"";""御見積り金額： ""-#,##0""円"""
'セルの表示形式
R.Value = "1000" '値を代入
R.Font.Size = 20 'フォントサイズを代入
R.Font.Bold = True '太字に変更
R.IndentLevel = 1 'インデントを１に変更
Set R = Range("B15") '変数Rにセルを代入
R.Value = "（消費税を含んでおります）" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G3") '変数Rにセルを代入
R.Value = "御見積番号：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G4") '変数Rにセルを代入
R.Value = "発行日：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G5") '変数Rにセルを代入
R.Value = "有効期限：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("F6") '変数Rにセルを代入
R.Value = "納入場所：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("F8") '変数Rにセルを代入
R.Value = "納入予定日：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("F9") '変数Rにセルを代入
R.Value = "御支払い条件：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("F17") '変数Rにセルを代入
R.Value = "担当者名：" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G17") '変数Rにセルを代入
R.Value = "○○○○○○" '値を代入
Set R = Range("G34") '変数Rにセルを代入
R.Value = "合計" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G35") '変数Rにセルを代入
R.Value = "消費税" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G36") '変数Rにセルを代入
R.Value = "税込み価格" '値を代入
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("H3") '変数Rにセルを代入
R.Value = "202000000-00" '値を代入
Set R = Range("H4") '変数Rにセルを代入
R.NumberFormatLocal = "yyyy年m月d日" 'セルの表示形式
R.Value = "2020/12/22" '値を代入
Set R = Range("H5") '変数Rにセルを代入
R.Value = "発行日から60日" '値を代入
Set R = Range("G6") '変数Rにセルを代入
R.Value = "東京都渋谷区○○○0-0-0 〇〇〇〇〇ビル 0000" '値を代入
R.VerticalAlignment = xlTop '縦上揃えに変更
R.WrapText = True '折返しする
Set R = Range("G8") '変数Rにセルを代入
R.NumberFormatLocal = "yyyy年m月d日" 'セルの表示形式
R.Value = "2020/12/31" '値を代入
Set R = Range("G9") '変数Rにセルを代入
R.Value = "御打合せ" '値を代入
Set R = Range("F11") '変数Rにセルを代入
R.Value = "benkyo room｜ブログサイト" '値を代入
R.Font.Size = 18 'フォントサイズを代入
Set R = Range("F13") '変数Rにセルを代入
R.Value = "https://watunabi.com" '値を代入
Set R = Range("F14") '変数Rにセルを代入
R.Value = "〒000-0000" '値を代入
Set R = Range("G14") '変数Rにセルを代入
R.Value = "TEL:000-0000-0000" '値を代入
Set R = Range("F15") '変数Rにセルを代入
R.Value = "東京都渋谷区○○○0-0-0 〇〇〇〇〇ビル 0000" '値を代入
R.VerticalAlignment = xlTop '縦上揃えに変更
R.WrapText = True '折返しする
Set R = Range("B37") '変数Rにセルを代入
R.Value = "備考" '値を代入
Set R = Range("C19") '変数Rにセルを代入
R.Value = "品目名称" '値を代入
R.Font.Size = 11 'フォントサイズを代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("D19") '変数Rにセルを代入
R.Value = "数量" '値を代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("E19") '変数Rにセルを代入
R.Value = "単位" '値を代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("F19") '変数Rにセルを代入
R.Value = "単価" '値を代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("G19") '変数Rにセルを代入
R.Value = "金額" '値を代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("H19") '変数Rにセルを代入
R.Value = "備考" '値を代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("B21:H32") '変数Rにセルを代入
R.HorizontalAlignment = xlCenter '横中央揃えに変更
Set R = Range("C21:C32,H21:H32") '変数Rにセルを代入
R.HorizontalAlignment = xlLeft '左寄せに変更
R.WrapText = True '折返しする
Set R = Range("D21:D32,F21:G32,H34:H36") '変数Rにセルを代入
R.NumberFormatLocal = "#,##0_ ;[赤]-#,##0 " 'セルの表示形式
R.HorizontalAlignment = xlRight '右寄せに変更
Set R = Range("G34:G36") '変数Rにセルを代入
R.HorizontalAlignment = xlRight '右寄せに変更
End Sub
Sub ロゴマークの画像を挿入する()
Dim F As String '画像ファイルのパス（データ型は文字列型のString）
Dim R As Range '挿入したい位置（セルで指定）（データ型はオブジェクト型のRange）
Dim W As Variant '画像の横幅指定ポイント値（データ型はバリアント型のVariant）
Dim S As Object '挿入した画像シェイプ（データ型はオブジェクト型のObject）
Dim N As String '画像につける名前（データ型は文字列型のString）
F = ThisWorkbook.Path & "\benkyo_room_banner468x60.png"
'画像ファイルのパス
Set R = Range("D2") '挿入したい位置（セルで指定）
W = Range("D2:H2").Width '画像の横幅指定ポイント値
N = "ロゴ" '画像につける名前
'画像を挿入
Set S = ActiveSheet.Shapes.AddPicture( _
Filename:=F, _
linktofile:=msoFalse, _
savewithdocument:=msoTrue, _
Left:=R.Left, _
Top:=R.Top, _
Width:=-1, _
Height:=-1)
S.Name = N '画像の名前を設定
S.LockAspectRatio = msoTrue '画像の縦横比を固定
S.Width = W '画像の横幅を設定
End Sub
Sub 角印の画像を挿入する()
Dim F As String '画像ファイルのパス（データ型は文字列型のString）
Dim R As Range '挿入したい位置（セルで指定）（データ型はオブジェクト型のRange）
Dim W As Variant '画像の横幅指定ポイント値（データ型はバリアント型のVariant）
Dim S As Object '挿入した画像シェイプ（データ型はオブジェクト型のObject）
Dim N As String '画像につける名前（データ型は文字列型のString）
F = ThisWorkbook.Path & "\benkyo_room_kakuinn2000x2000.gif"
'画像ファイルのパス
Set R = Range("H10") '挿入したい位置（セルで指定）
W = Range("H10").Width '画像の横幅指定ポイント値
N = "角印" '画像につける名前
' 画像を挿入
Set S = ActiveSheet.Shapes.AddPicture( _
Filename:=F, _
linktofile:=msoFalse, _
savewithdocument:=msoTrue, _
Left:=R.Left, _
Top:=R.Top, _
Width:=-1, _
Height:=-1)
S.Name = N '画像の名前を設定
S.LockAspectRatio = msoTrue '画像の縦横比を固定
S.Width = W '画像の横幅を設定
End Sub
Sub 計算式を入れる()
Range("G21:G32") = "=IF(D21="""","""",ROUNDUP(D21*F21,0))" '「金額」欄に数式を代入
Range("H34") = "=SUM(G21:G32)" '「合計」欄に数式を代入
Range("H35") = "=ROUNDDOWN(H34*0.1,0)" '「消費税」欄に数式を代入
Range("H36") = "=SUM(H34:H35)" '「税込み価格」欄に数式を代入
Range("B13") = "=H36" '「御見積り金額」欄に数式を代入
End Sub
Sub 印刷時のページ設定()
With ActiveSheet.PageSetup 'With構文で繰り返し部分を省略する
.PrintArea = "A1:I43" '印刷範囲の設定
.CenterHorizontally = True '水平方向でページ中央に配置
.Zoom = False '拡大、縮小率を「指定しない」
.FitToPagesWide = 1 '横方向１ページで印刷
.FitToPagesTall = False '縦方向はページ数を「指定しない」
End With
End Sub
お疲れさまでした。これが完成品です。 ↓
このままでは見積書雛形は保存されていませんので最後は手動で任意の場所に保存してください。
ようやく形になりましたが、作っていて結構面白かったので今度はこの見積書につける内訳書を作ってみようと思います。 最後まで読んでくださってありがとうございました！