|
画像ファル名の頭に"DSCF" と入っていると仮定します。
B2に
1
と入力すると、
DSCF0001〜DSCF0010
をシートに取込みます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ファイル As String
Dim i As Long
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
'全てのシェイプの削除
ActiveSheet.DrawingObjects.Delete
'画像ファイル名が連番でないとエラーになる
For i = 1 To 10
ファイル = "I:\雑誌\" & "DSCF" & Format(Target.Value + i - 1, "0000") & ".jpg"
'シェイプ名を連番でつける
ActiveSheet.Pictures.Insert(ファイル).Name = "画像" & i
With ActiveSheet.Shapes("画像" & i)
'i = 1だったら
If i = 1 Then
'シェイプのTopをD4セルのTopに設定
.Top = ActiveSheet.Cells(4, 4).Top
Else 'i>1だったら
'シェイプのTopを前の画像の下に設定
.Top = ActiveSheet.Shapes("画像" & i - 1).Top + ActiveSheet.Shapes("画像" & i - 1).Height
End If
'LeftをD4セルのLeftに設定
.Left = ActiveSheet.Cells(4, 4).Left
.LockAspectRatio = msoTrue
.Height = 270#
End With
Next i
End Sub
|
|