GBKEE

¦^´_ 1# whirlwind963

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim j As Integer, MyPath As String
   
4.     j = 2
   
5.     MyPath = "C:\My Pictures\"
   
6.     While Cells(j, "C") <> ""
   
7.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
   
8.            'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
   
9.             Cells(j, "D").Select
   
10.            If Dir(MyPath & Cells(j, "C")) <> "" Then
    
11.                 With ActiveSheet.Pictures.Insert(MyPath & Cells(j, "C"))
    
12.                     '  .ShapeRange.LockAspectRatio = msoTrue
    
13.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
    
14.                     .ShapeRange.LockAspectRatio = msoFalse
    
15.                     .ShapeRange.Height =  100
    
16.                     .ShapeRange.Width =  200,
    
17.                     .ShapeRange.Rotation = 0
    
18.                     .Placement = xlMoveAndSize
    
19.                     .PrintObject = True
    
20.                 End With
    
21.             End If
    
22.         End If
    
23.         j = j + 1
    
24.     Wend
    
25.     Range("C2").Select
    
26. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# c_c_lai

1. Option Explicit
   
2. Sub Ex()
   
3.     With ActiveSheet
   
4.         .Pictures.Delete
   
5.         .Cells(5, "D").Select
   
6.         With .Pictures.Insert("d:\ex1.gif")
   
7.             .ShapeRange.LockAspectRatio = msoFalse '¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
   
8.             .ShapeRange.Height = IIf(.ShapeRange.Height > 100, 100, .ShapeRange.Height)
   
9.             .ShapeRange.Width = IIf(.ShapeRange.Width > 200, 200, .ShapeRange.Width)
   
10.             End With
    
11.     End With
    
12. End Sub
    
13.                     

½Æ»s¥N½X

GBKEE

¦^´_ 5# c_c_lai
2# ¦³»~ ¤w§ó¥¿

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim j As Integer, MyPath As String
   
4.     j = 2
   
5.     MyPath = "D:\My Pictures\"
   
6.     While Cells(j, "C") <> ""
   
7.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
   
8.            'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
   
9.             Cells(j, "D").Select
   
10.             Selection.RowHeight = 82
    
11.            If Dir(MyPath & Cells(j, "C")) <> "" Then
    
12.                 With ActiveSheet.Pictures.Insert(MyPath & Cells(j, "C"))
    
13.                     '  .ShapeRange.LockAspectRatio = msoTrue
    
14.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
    
15.                     .ShapeRange.LockAspectRatio = msoFalse
    
16.                     .ShapeRange.Height = IIf(.ShapeRange.Height > 100, 100, .ShapeRange.Height)
    
17.                     .ShapeRange.Width = IIf(.ShapeRange.Width > 200, 200, .ShapeRange.Width)
    
18.                     .ShapeRange.Rotation = 0#
    
19.                     .Placement = xlMoveAndSize
    
20.                     .PrintObject = True
    
21.                 End With
    
22.             End If
    
23.         End If
    
24.         j = j + 1
    
25.     Wend
    
26.     Range("C2").Select
    
27. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# whirlwind963

1. Option Explicit
   
2. Sub Ex() '¶Ç¦^¸ê®Æ§¨¤¤²Å¦X[C2] ªºÀÉ®×
   
3.     Dim j As Integer, MyPath As String, xlJpg As String
   
4.     j = 2
   
5.     ActiveSheet.Pictures.Delete
   
6.     MyPath = "C:\My Pictures\"
   
7.     'Dir ¨ç¼Æ ¶Ç¦^¤@­Ó String ¡A¥Î¥Hªí¥Ü¦X¥G±ø¥ó¡BÀÉ®×ÄÝ©Ê¡BºÏºÐ¼Ð°Oªº¤@­ÓÀɮצWºÙ¡B©Î¥Ø¿ý¡BÀɮק¨¦WºÙ¡C
   
8.     xlJpg = Dir(MyPath & [C2] & "*.JPG")       '¶}ÀY= [C2]ªº¦r¦ê
   
9.    'xlJpg = Dir(MyPath & "*" & [C2] & "*.JPG")  '¥]§t[C2]ªº¦r¦ê
   
10.    'xlJpg = Dir(MyPath & "*" & [C2] & ".JPG")   '¥]§t[C2]ªº¦r¦ê¦b§ÀºÝ
    
11.     Do While xlJpg <> ""
    
12.        Cells(j, "D").Select
    
13.         With ActiveSheet.Pictures.Insert(MyPath & xlJpg)
    
14.             '  .ShapeRange.LockAspectRatio = msoTrue
    
15.             '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
    
16.             .ShapeRange.LockAspectRatio = msoFalse
    
17.             .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
    
18.             .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
    
19.             .ShapeRange.Rotation = 0#
    
20.             .Placement = xlMoveAndSize
    
21.             .PrintObject = True
    
22.         End With
    
23.         j = j + 1
    
24.         xlJpg = Dir
    
25.     Loop
    
26.     Range("C2").Select
    
27. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# whirlwind963

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim j As Integer, MyPath As String, MyFile As String, k, L
   
4.     For k = 1 To 2                          'A,BÄæ
   
5.         For L = 4 To 5                      'D,EÄæ
   
6.             j = 2
   
7.             While Cells(j, "C") <> ""       'CÄ欰ÀɦW
   
8.                 MyPath = Cells(j, k)        'AÄæ,BÄ欰¦ì§}
   
9.                 If UCase(Cells(j, "C")) Like "*W*" Then  '¦r¦ê¤¤¦³"ABCD"
   
10.                     On Error Resume Next
    
11.                     MyFile = Dir(MyPath & "*" & Cells(j, "C") & "*.*")       '  C2 = "ABCD" ->"1AABCD.png"
    
12.                     If MyFile <> "" Then
    
13.                         Cells(j, L).Select   'D,EÄæ
    
14.                         With ActiveSheet.Pictures.Insert(MyPath & MyFile)
    
15.                             .ShapeRange.LockAspectRatio = msoFalse
    
16.                             .ShapeRange.Height = 100#
    
17.                             .ShapeRange.Width = 100#
    
18.                             .ShapeRange.Rotation = 0#
    
19.                             .Placement = xlMoveAndSize
    
20.                             .PrintObject = True
    
21.                         End With
    
22.                     End If
    
23.                 End If
    
24.                 j = j + 1
    
25.             Wend
    
26.             Range("C2").Select
    
27.         Next
    
28.     Next
    
29. End Sub

½Æ»s¥N½X