VBAで～ 第５回 の資料 続き

４　写真を挿入する

昨日 は１、２、３をやったので、
続きということで、４　になっています。

1月～12月のカレンダーに、それぞれ写真を挿入するので、
12枚の写真を用意します。
写真は、同じ大きさ、サイズの調整などが必須ですが、
これをやっていると、講座の時間内に収まりきらないので、
写真（jpg 画像）、ファイル名 1.jpg、2.jpg、～、12.jpg まで、
事前にいただいてます。

変数の定義

VBAで～ 第５回 の資料 で作成した、
エクセルファイルと同じフォルダに、
その12枚の画像を入れておきます。

そうしたら、そのファイルを開いて、
続きのコードを追加していきます。
今までは、変数 i だったら、
たんに、Dim i としか書いてませんでしたが、
何を扱う変数なのか、定義付けします。
むかしからの言語だと、
どういう型を、変数として使っているか、
書く必要があった、ということ。

画像ファイル名を格納する変数 String 型（文字列）

　　 Dim picName As String

今までに挿入した変数にも、
Dim i
Dim j
Dim saishuubi
Dim year

厳密には、↓ の様に記述した方が、エラーやバグを防止するそうです。Integer は、整数型だそう。
Dim i As Integer
Dim j As Integer
Dim saishuubi As Integer
Dim year As Integer
この下に、画像ファイル名を格納する変数を追加

図形や画像オブジェクトを扱う変数 Shape 型

図形や画像オブジェクトを扱う変数 Shape 型
　　Dim myShape As Shape
これは、画像ファイル名を格納する変数の下に追加します。

画像をシートに配置する

このコードについて説明していると、
講座の時間内に収まらないので、写経してくださいということ。

picName = ActiveWorkbook.Path & “¥” & Trim(Str(i) & “.jpg”)
Set myShape = ActiveSheet.Shapes.AddPicture( _
　　Filename:=picName, _
　　linktofile:=False, _
　　savewithdocument:=True, _
　　Left:=Selection.Left, _
　　Top:=Selection.Top, _
　　Width:=0, _
　　Height:=0)
myShape.ScaleHeight 0.5, msoCTrue
myShape.ScaleWidth 0.5, msoCTrue

追加する場所は、下記の、さいしょのNext の下です。
　　　　Next
　　Next
　　Application.DisplayAlerts = True
End Sub

実行すると、画像が挿入されます。

＊ ActiveWorkbook.Pat hで、
今、使っているエクセルファイルのPath 、
つまり、HDの住所　を指定しているので、
このエクセルファイルと同じHDの住所に、
12枚画像の画像が入ってないと、当然ですが、
　　実行時エラー’1004′
　　指定したファイルが見つかりませんでした。
というエラーメッセージが出てしまいます。

５　土日の日付と曜日を色付け

Select Case 構文を使って、
土曜日を青、
日曜日を赤
にしてみましょう。と書いてあります。
　　Cells(27, j + 1).Font.Color = vbBlue
くらいは、わかりますが、
これをうまくまとめるにはどうしたらいいのかな～と、
やっぱり回答例を見てしまいました。

hiduke = CDate(Str(year) & “/” & Str(i) & “/” & Str(j))
　　Cells(27, j + 1) = j
　　Cells(28, j + 1).Value = Format(hiduke, “aaa”)
の下に、
　　Select Case Format(hiduke, “aaa”)
　　　　Case “土”
　　　　　　Cells(27, j + 1).Font.Color = vbBlue
　　　　　　Cells(28, j + 1).Font.Color = vbBlue
　　　　Case “日”
　　　　　　Cells(27, j + 1).Font.Color = vbRed
　　　　　　Cells(28, j + 1).Font.Color = vbRed
と、なっていました。

実行すると、

回答例ばかり、見っぱなしでしたが、
これで、カレンダー作成 が完成しました。

Sub sample()
　　Dim i As Integer
　　Dim j As Integer
　　Dim saishuubi As Integer
　　Dim year As Integer
　　Dim hiduke As String
　　Dim picName As String
　　Dim myShape As Shape

　　　　｜
　　この間、省略
　　　　｜

　　　　Else
　　　　　　saishuubi = 28
　　　　End If
　　End Select
　　For j = 1 To saishuubi
　　hiduke = CDate(Str(year) & “/” & Str(i) & “/” & Str(j))
　　　　Cells(27, j + 1) = j
　　　　Cells(28, j + 1).Value = Format(hiduke, “aaa”)
　　　　Select Case Format(hiduke, “aaa”)
　　　　　Case “土”
　　　　　　Cells(27, j + 1).Font.Color = vbBlue
　　　　　　Cells(28, j + 1).Font.Color = vbBlue
　　　　　Case “日”
　　　　　　Cells(27, j + 1).Font.Color = vbRed
　　　　　　Cells(28, j + 1).Font.Color = vbRed
　　　　End Select
　　　　Cells.HorizontalAlignment = xlCenter
　　　　Range(“A27:A28”).Merge

　　　　｜
　　この間、省略
　　　　｜

　　Next
　　picName = ActiveWorkbook.Path & “\” & Trim(Str(i) & “.jpg”)
　　Set myShape = ActiveSheet.Shapes.AddPicture( _
　　　　Filename:=picName, _
　　　　linktofile:=False, _
　　　　savewithdocument:=True, _
　　　　Left:=Selection.Left, _
　　　　Top:=Selection.Top, _
　　　　Width:=0, _
　　　　Height:=0)
　　myShape.ScaleHeight 0.5, msoCTrue
　　myShape.ScaleWidth 0.5, msoCTrue
　Next
　Application.DisplayAlerts = True
End Sub

サイトマップ