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

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

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

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

c_c_lai

¦^´_  c_c_lai
À°§Ú¬Ý¤@¤U
§Ú·Q­n¦bAÄæBÄæ©ñ¦ì§}
CÄ欰¹Ï¤ùÀɦW
DÄ欰Åã¥ÜAªº¹Ï¤ù
EÄæÅã¥ÜBªº¹Ï¤ù
¨Ï ...
whirlwind963 µoªí©ó 2012-12-15 09:45

§Aªº°j°é³B²z¦a«D±`©_©Ç¡A

1. 
   
2. For k = 1 To 2
   
3.         For l = 4 To 5
   
4.                j = 2
   
5.               While Cells(j, "C") <> ""
   
6.                       '  ......
   
7.                       j = j + 1
   
8.               Wend      '    ¨C¦¸°j°é³£±qÀY¶]¤@¦¸
   
9.         Next
   
10. Next

½Æ»s¥N½X

§A§â¦¹ÀɮפW¶Ç¡A§Ú¹ê¦aºt½m¤@¦¸¡C

c_c_lai

¦^´_ 11# whirlwind963
¦^´_ 13# GBKEE
¬P´Á¤éµL²á¡A«K°Êµ§­×§ï¤F GBKEE ¤j¤jªºµ{¦¡¡G (±æ¤£­n¤¶·N)

1. Option Explicit
   
2. 
   
3. Sub Ex2()
   
4.     Dim j As Integer, k As Integer, MyPath As String, MyFile As String
   
5.    
   
6.     Application.ScreenUpdating = False
   
7.    
   
8.     ActiveSheet.Pictures.Delete
   
9.     j = 2
   
10.     While Cells(j, "C") <> ""                           '  CÄ欰ÀɦW
    
11.         For k = 1 To 2
    
12.             MyPath = Cells(j, k)                       
    
13.            '  AÄæ,BÄ欰¦ì§} ¨Ò¦p: D:\My Pictures\15\ ¡B¤Î E:\Amazing Pictures\16\ µ¥µ¥¡C
    
14.             If UCase(Cells(j, "C")) Like "*ABCD*" Then  ' ¦r¦ê¤¤¦³"ABCD"
    
15.                 On Error Resume Next
    
16.                 MyFile = Dir(MyPath & "*" & Cells(j, "C") & "*.*")
    
17.                 If MyFile <> "" Then
    
18.                     Cells(j, IIf(k = 1, 4, 5)).Select   ' D,EÄæ
    
19.                     With ActiveSheet.Pictures.Insert(MyPath & MyFile)
    
20.                         .ShapeRange.LockAspectRatio = msoFalse
    
21.                         .ShapeRange.Height = 100#
    
22.                         .ShapeRange.Width = 100#
    
23.                         .ShapeRange.Rotation = 0#
    
24.                         .Placement = xlMoveAndSize
    
25.                         .PrintObject = True
    
26.                     End With
    
27.                 End If
    
28.             End If
    
29.         Next
    
30.         j = j + 1
    
31.     Wend
    
32.     Range("C2").Select
    
33.     Application.ScreenUpdating = True
    
34. End Sub

½Æ»s¥N½X