Excel VBA 質問スレッド No.45 (未解決)

画像の挿入

投稿者 : bun     投稿日時 : 2018/05/16(Wed) 10:58:34     OS : Windows 7     EXCEL : Excel 2007
B列に10桁の商品名があり、その商品名の画像をフォルダーより抽出して
C列に張り付けるマクロを組んで使用しています
新しくB列の商品名に枝番01とかaとか”蓋”とかをつけて部品を管理することになり
下記のマクロを改変して、B列の商品名にに完全一致の画像をC列に、D列以降に枝番付の部分一致の画像を、順次貼り付けたいと考えております。
枝番の数は固定しておりません。
ご教授よろしくお願いいたします。

Sub 画像の取り込み()
Dim Shell, myfolder, myPath As String
Dim i As Long
Dim x As Double
Dim s As String

Set Shell = CreateObject("Shell.Application")
Set myfolder = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10)
If Not myfolder Is Nothing Then myPath = myfolder.Items.Item.Path & "\"


With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
Set r = .Cells(i, 3).MergeArea
s = myPath & .Cells(i, 2).Value & ".jpg"
If Dir(s) = "" Then
s = myPath & "noimage.jpg"
Else
Dir Application.Path
End If

With .Pictures.Insert(s).ShapeRange
.LockAspectRatio = msoTrue
x = Application.Min(r.Width / .Width, r.Height / .Height)
If x < 1 Then .Width = .Width * x
.Left = r.Left
.Top = r.Top
End With
Next
End With

Set r = Nothing
End Sub

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2019-07-18 01:54:27 )

Page
Top