[發問] 關鍵字抓圖片

請問一個資料夾裡面有很多的圖片
我從C2開始輸入檔名
但我只知道關鍵字
例如:ABCD123456  我只輸入ABCD
這樣也能抓到圖片
下面的程式碼哪裡有錯嗎
麻煩各位~幫我看一下
Sub Macro1()
j = 2
MyPath = "C:\My Pictures\"
MyFile = Dir(MyPath & Cells(j, "C") & "*.jpg")
While Cells(j, "C") <> ""
      NN = Cells(j, "C")
      Cells(j, "D").Select
      On Error Resume Next
      ActiveSheet.Pictures.Insert(MyFile).Select
      Selection.ShapeRange.LockAspectRatio = msoTrue
      Selection.ShapeRange.Height = 100#
      Selection.ShapeRange.Width = 100#
      Selection.ShapeRange.Rotation = 0#
      With Selection
      .Placement = xlMoveAndSize
      .PrintObject = True
      End With
j = j + 1
Wend
Range("C2").Select
End Sub

樓主熱帖

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

2^#

發表於 2012-12-12 14:09 | 顯示全部帖子

回復 6# GBKEE
不好意思
我想要的正好是相反的
假設檔名為ABCD123456.jpg
我在C2輸入ABCD
D2能顯示ABCD123456.JPG的圖片

TOP

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

3^#

發表於 2012-12-15 09:45 | 顯示全部帖子

回復 9# c_c_lai
幫我看一下
我想要在A欄B欄放位址
C欄為圖片檔名
D欄為顯示A的圖片
E欄顯示B的圖片
使用FOR 迴圈
圖片會在D欄重疊
該怎麼改呢
   Option Explicit

Sub Ex()
      Dim j As Integer, MyPath As String, MyFile As String, k, l

      For k = 1 To 2
         For l = 4 To 5
      j = 2
      While Cells(j, "C") <> "" 'C2為檔名
      MyPath = Cells(j, k)  'A2 B2為位址
         If UCase(Cells(j, "C")) Like "*W*" Then  '字串中有"ABCD"
            '  UCase 函數傳回一個 Variant (String)，所含為轉成大寫之字串。
            Cells(j, l).Select 'D2 E2為圖片
            On Error Resume Next
            MyFile = Dir(MyPath & "*" & Cells(j, "C") & "*.*")    '  C2 = "ABCD" ->"1AABCD.png"

            If MyFile <> "" Then
                  With ActiveSheet.Pictures.Insert(MyPath & MyFile)
                     '  .ShapeRange.LockAspectRatio = msoTrue
                     '  在調整圖案大小時，可以分別地調整圖案的長度和寬度
                     .ShapeRange.LockAspectRatio = msoFalse
                     .ShapeRange.Height = 100#
                     .ShapeRange.Width = 100#
                     .ShapeRange.Rotation = 0#
                     .Placement = xlMoveAndSize
                     .PrintObject = True
                  End With
            End If
         End If
         j = j + 1
      Wend
      Range("C2").Select
      Next
      Next
End Sub

TOP