| |
本当にありがとうございます！
早速試してみたいと思います。
U03に感謝します、本当にありがとうございます！！
取り急ぎお礼まで♪───Ｏ（≧∇≦）Ｏ────♪
▼UO3 さん：
>▼ぴょんぴょん さん：
>
>上で質問させていただいているように、要件がクリアには把握できていないのですが
>・シートのＢ列に画像ファイル名（.jpg 等の拡張子なし）が列挙されている。
> （この部分は実際のセル範囲に変更願います）
>・そのファイル名を持つ、jpegあるいはjpgあるいはgifデータが指定フォルダにあれば
>・そのセルの左のセル（Ａ列）に画像を挿入。
>・画像縦横比率を維持してセルにあてはめる部分は、少しすっきり（？）したロジックに。
>このような仕様だとしてコードを書いてみました。
>
>Sub Sample()
> Dim c As Range
> Dim myFold As Object
> Dim myPath As String
> Dim myName As String
> Dim ext As Variant
> Dim myPic As String
> Dim r As Range
>
> Set myFold = CreateObject("Shell.Application").BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")
> If myFold Is Nothing Then Exit Sub
> myPath = myFold.Items.Item.Path
> Set myFold = Nothing
> With ActiveSheet
> For Each c In .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
> If Len(c.Value) > 0 Then
> For Each ext In Array("jpeg", "jpg", "gif")
> myPic = Dir(myPath & "\" & c.Value & "." & ext)
> If Len(myPic) > 0 Then
> c.Offset(, -1).Activate
> With ActiveSheet.Pictures.Insert(myPath & "\" & myPic)
> Set r = .TopLeftCell
> With .ShapeRange
> .LockAspectRatio = msoTrue
> If .Height > r.Height Then .Height = r.Height
> If .Width > r.Width Then .Width = r.Width
> End With
> Set r = Nothing
> End With
> Exit For
> End If
> Next
> End If
> Next
> End With
>End Sub
|
|
きょん
- 12/2/7(火) 23:31 -
