エクセルでセル枠に大きい写真を自動で枠にピッタリ収まるようにしたいです。
このVBAにボタンを作成してもうまくいきません
Sub InsertPictures()
Dim i As Integer
Dim myDir As String
Const myHeight = 200 '行の高さ。0-409を指定。写真のサイズがこれで調整される。
Const myWidth = 50 '列の幅。0 - 255を指定。
Dim myFName As String
myDir = Application.GetOpenFilename(FileFilter:="すべての図(.jpg),.jpg")
If myDir = "False" Then Exit Sub
myDir = Left(myDir, Len(myDir) - Len(Dir(myDir)))
Application.ScreenUpdating = False
ActiveSheet.DrawingObjects.Delete
Columns(2).ClearContents
Rows.AutoFit
i = 1
myFName = Dir(myDir & "*.jpg")
Do While myFName <> ""
With Cells(i, 1)
.Activate
.RowHeight = myHeight
End With
With ActiveSheet
.Pictures.Insert myDir & myFName
With .Shapes(i)
.LockAspectRatio = msoTrue
.Height = myHeight
End With
End With
Cells(i, 2).Value = myFName
myFName = Dir
i = i + 1
Loop
Columns(1).ColumnWidth = myWidth
Columns(2).AutoFit
Application.ScreenUpdating = True
End Sub
ご教授ください
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。