[µo°Ý] ÃöÁä¦r§ì¹Ï¤ù

whirlwind963

½Ð°Ý¤@­Ó¸ê®Æ§¨¸Ì­±¦³«Ü¦hªº¹Ï¤ù
§Ú±qC2¶}©l¿é¤JÀɦW
¦ý§Ú¥uª¾¹DÃöÁä¦r
¨Ò¦p:ABCD123456  §Ú¥u¿é¤JABCD
³o¼Ë¤]¯à§ì¨ì¹Ï¤ù
¤U­±ªºµ{¦¡½X­þ¸Ì¦³¿ù¶Ü
³Â·Ð¦U¦ì~À°§Ú¬Ý¤@¤U
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

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

c_c_lai

¦^´_ 2# GBKEE

1.                     .ShapeRange.Height = 100#
   
2.                     .ShapeRange.Width = 100#
   
3.                     .ShapeRange.Rotation = 0#

½Æ»s¥N½X

½Ð±Ðª©¤j¡A¤W­±©Ò­z "°ª«×"¡B"¼e«×"ªº³]©w°ÝÃD¡C
°²³]§Ú¹Ï¤ùªº¤j¤p¤£¤@¡A§Ú¦p¦ó¯à±N¨ä¶×¤J°¦¤j¤p­­¨î¡A
(¦p .ShapeRange.Height = 100# ¤§§i¥Ü)
ÁÂÁ±z¡I

¤U¸ü (459.19 KB)

2012-12-12 09:48

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

c_c_lai

¦^´_ 4# GBKEE
¯u¤£¦n·N«ä¡Aª¬ªp¨Ì¡A¦pªþ¥ó¡G
My Pictures.rar (315.17 KB)

¤U¸ü¦¸¼Æ: 8

2012-12-12 11:01

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

c_c_lai

¦^´_ 6# GBKEE
§Ú¤w¸g­×¥¿§¹¦¨¡A¦p¹Ï¡AÁÂÁ±z¡I

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

½Æ»s¥N½X

¤U¸ü (195.27 KB)

2012-12-12 12:34

whirlwind963

¦^´_ 6# GBKEE
¤£¦n·N«ä
§Ú·Q­nªº¥¿¦n¬O¬Û¤Ïªº
°²³]ÀɦW¬°ABCD123456.jpg
§Ú¦bC2¿é¤JABCD
D2¯àÅã¥ÜABCD123456.JPGªº¹Ï¤ù

c_c_lai

¦^´_ 8# whirlwind963

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

½Æ»s¥N½X

¤U¸ü (313.9 KB)

2012-12-12 15:59

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