Hsieh

¦^´_ 1# jackyliu

¹Ï¤ù©R¦W³W«h¤£¬O«ÜÀ´¡A¥ý¸Õ¸Õ³o¼Ë¬Ý«ç¼Ë¤£¦P

1. Sub Ex()
   
2. Dim A As Range, C As Range
   
3. ar = Array("C", "F", "T")
   
4. ay = Array(8, 9, 10)
   
5. ak = Array("", 0, 1, 2, 3)
   
6. fd = "C:\TEST\" '¹Ï¤ù¥Ø¿ý
   
7. With Sheet1
   
8. .Pictures.Delete
   
9. For Each C In .Range(.[C3], .[C65536].End(xlUp))
   
10. r = C.Row
    
11.     For i = 0 To 2
    
12.        For j = 0 To 3
    
13.        mystr = IIf(ak(j) = "", "", "-" & ak(j))
    
14.        fs = C & "-" & ar(i) & mystr & ".jpg"
    
15.        If Dir(fd & fs) <> "" Then
    
16.           Set A = .Cells(r, IIf(j = 0, ay(i), 10 + j))
    
17.           With .Pictures.Insert(fd & fs)
    
18.             .Top = A.Top: .Left = A.Left: .Height = A.Height: .Width = A.Width
    
19.           End With
    
20.        End If
    
21.        Next
    
22.     Next
    
23. Next
    
24. End With
    
25. End Sub

½Æ»s¥N½X

Hsieh

52-T-1­n¦b½s¸¹52ªº­þ¤@Äæ?
53.jpg ­n¦b½s¸¹53ªº­þ¤@Äæ?

Hsieh

¦^´_ 5# jackyliu


    H2¡BI2ªºC¡BF¨Ã¨S¦³¦b¹Ï¤ùÀɦWªº½s¸¹³W«h¤º¶Ü?
¤£µM¬°¦ó53.jpg  ·|¦bHÄæ¦ì?
½Ð¦b¦UÀx¦s®æ¦ì¸m¶ñ¤J¹Ï¤ùÀɦW¡A¥HÂç²M©R¦W³W«h»Pªí®æ¦ì¸mªºÃö«Y

Hsieh

¦^´_ 7# jackyliu

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. fd = ThisWorkbook.Path & "\" '¹ÏÀɥؿý
   
4. fs = Dir(fd & "*.jpg")
   
5. Do Until fs = ""
   
6. If InStr(fs, "-") = 0 Then '¥u¦³¼Æ­È
   
7.    d(fs) = "H" & Val(fs) + 2 '¦]¬°¦b²Ä¦C©Ò¥H¥[2
   
8.    ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '¥u¦³1­Ó¤À¹j²Å¸¹
   
9.    '²Ä2½X¬°C´N¬OIÄæ¡A§_«h´N¦bJÄæ
   
10.      If Split(fs, "-")(1) = "C" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
11.    Else
    
12.    '²Ä3½X¬O1´N¦bKÄæ¡A2´N¦bLÄæ¡A¨ä¾l¦bMÄæ
    
13.    k = IIf(Split(fs, "-")(2) = 1, "K", IIf(Split(fs, "-")(2) = 2, "L", "M"))
    
14.    d(fs) = k & Val(fs) + 2
    
15. End If
    
16. fs = Dir
    
17. Loop
    
18. With Sheet1
    
19. .Pictures.Delete '²M°£©Ò¦³¹Ï¤ù
    
20. Application.ScreenUpdating = False
    
21. For Each ky In d.keys
    
22.    Set A = .Range(d(ky)) '¹Ï¤ù´¡¤Jªº¦ì¸m
    
23.       With .Pictures.Insert(fd & ky) '´¡¤J¹ÏÀÉ
    
24.          .Top = A.Top
    
25.          .Left = A.Left
    
26.          .Height = A.Height
    
27.          .Width = A.Width
    
28.        End With
    
29. Next
    
30. End With
    
31. Application.ScreenUpdating = True
    
32. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# jackyliu
³]©w¦¨Àx¦s®æ¤j¤p

Hsieh

¦^´_ 12# jackyliu
If InStr(fs, "-") = 0 Then '¥u¦³¼Æ­È
¥ÎINSTR¨ç¼Æ´ú¸Õ¬Ý¬Ý¹Ï¤ùÀɦW¬O§_¦³"-"¸¹¡A¦]¬°¥u¦³¼Æ­È®É¤~¨S¦³"-"¸¹

d(fs) = "H" & Val(fs) + 2 '¦]¬°¦b²Ä¦C©Ò¥H¥[2
¦r¨åª«¥ó¬O¥Î¨ÓÀx¦sÀɦW¹ïÀ³ªº¦ì§}¡A Val(fs)·|±o¨ìNO­È¡A¦ÓNOªº1¬O±q²Ä3¦C¶}©l¡A©Ò¥H¦C¦ì­n¥[2


¦Ü©ó§A­n¼W¥[Äæ¦ìªº°ÝÃD¡A¤S¦^¨ì¤§«eªº­«ÂI:ÀɦW¸òÀx¦sÄæ¦ìªº¹ïÀ³³W«h
­n¦Û¤v²M·¡¹ïÀ³³W«h¡AµM«á¦b§PÂ_¦¡¤¤¤@±ø¥ó¨Ó¼g¤J¦r¨åª«¥ó

Hsieh

¦^´_ 14# jackyliu

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. fd = ThisWorkbook.Path & "\" '¹ÏÀɥؿý
   
4. fs = Dir(fd & "*.jpg")
   
5. Do Until fs = ""
   
6. If InStr(fs, "-") = 0 Then '¥u¦³¼Æ­È
   
7.    d(fs) = "H" & Val(fs) + 2 '¦]¬°¦b²Ä¦C©Ò¥H¥[2
   
8.    ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '¥u¦³1­Ó¤À¹j²Å¸¹
   
9.    '²Ä2½X¬°C´N¬OIÄæ¡A§_«h´N¦bJÄæ
   
10.      If Split(fs, "-")(1) = "C" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
11.    Else
    
12.    '²Ä3½X¬O1´N¦bKÄæ¡A2´N¦bLÄæ¡A¨ä¾l¦bMÄæ
    
13.    ar = Split(fs, "-")
    
14.    p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '²Ä2½X¬OC´N¶Ç¦^"K"ªº¦r¤¸½X¡A²Ä2½X¬OT´N¶Ç¦^"L"ªº¦r¤¸½Xµ¹ÅܼÆp
    
15.    k = Chr(Val(ar(2)) + p) '¦r¦êÅܼÆkªº­È¬O²Ä3½X+p¹ïÀ³¨ìªº¦r¦ê(´N¬OÄæ¦ì)
    
16.    d(fs) = k & Val(fs) + 2
    
17. End If
    
18. fs = Dir
    
19. Loop
    
20. With Sheets("Sheet1")
    
21. .Pictures.Delete '²M°£©Ò¦³¹Ï¤ù
    
22. Application.ScreenUpdating = False
    
23. For Each ky In d.keys
    
24.    Set A = .Range(d(ky)) '¹Ï¤ù´¡¤Jªº¦ì¸m
    
25.       With .Pictures.Insert(fd & ky) '´¡¤J¹ÏÀÉ
    
26.          .ShapeRange.LockAspectRatio = msoFalse '¸Ñ°£ªø¼e¤ñ¨Ò
    
27.          .Top = A.Top
    
28.          .Left = A.Left
    
29.          .Height = A.Height
    
30.          .Width = A.Width
    
31.        End With
    
32. Next
    
33. End With
    
34. Application.ScreenUpdating = True
    
35. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 16# jackyliu

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. fd = ThisWorkbook.Path & "\" '¹ÏÀɥؿý
   
4. fs = Dir(fd & "*.jpg")
   
5. Do Until fs = ""
   
6. If InStr(fs, "-") = 0 Then '¥u¦³¼Æ­È
   
7.    d(fs) = "H" & Val(fs) + 2 '¦]¬°¦b²Ä¦C©Ò¥H¥[2
   
8.    ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '¥u¦³1­Ó¤À¹j²Å¸¹
   
9.    '²Ä2½X¬°C´N¬OIÄæ¡A§_«h´N¦bJÄæ
   
10.    V = Split(fs, "-")(1)
    
11.      If Split(fs, "-")(1) Like "C*" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
12.    Else
    
13.    '²Ä3½X¬O1´N¦bKÄæ¡A2´N¦bLÄæ¡A¨ä¾l¦bMÄæ
    
14.    ar = Split(fs, "-")
    
15.    p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '²Ä2½X¬OC´N¶Ç¦^"K"ªº¦r¤¸½X¡A²Ä2½X¬OT´N¶Ç¦^"L"ªº¦r¤¸½Xµ¹ÅܼÆp
    
16.    k = Chr(Val(ar(2)) * 2 + p) '¦r¦êÅܼÆkªº­È¬O²Ä3½X+p¹ïÀ³¨ìªº¦r¦ê(´N¬OÄæ¦ì)
    
17.    d(fs) = k & Val(fs) + 2
    
18. End If
    
19. fs = Dir
    
20. Loop
    
21. With Sheets("Sheet1")
    
22. .Pictures.Delete '²M°£©Ò¦³¹Ï¤ù
    
23. Application.ScreenUpdating = False
    
24. For Each ky In d.keys
    
25.    Set A = .Range(d(ky)) '¹Ï¤ù´¡¤Jªº¦ì¸m
    
26.       With .Pictures.Insert(fd & ky) '´¡¤J¹ÏÀÉ
    
27.          .ShapeRange.LockAspectRatio = msoFalse '¸Ñ°£ªø¼e¤ñ¨Ò
    
28.          .Top = A.Top
    
29.          .Left = A.Left
    
30.          .Height = A.Height
    
31.          .Width = A.Width
    
32.        End With
    
33. Next
    
34. End With
    
35. Application.ScreenUpdating = True
    
36. End Sub

½Æ»s¥N½X

Hsieh

¥ÎOPEN¨Æ¥óµ{§ÇÅX°Ê§Y¥i¶}±ÒÀÉ®×´N¸ü¤J¹Ï¤ù
Sub Ex()
§ï¦¨Sub auto_open()
§â©Ò¦³µ{¦¡½X©ñ¦b¤@¯ë¼Ò²Õ


ÀɮצWºÙ¥u­n¬O®Ú¾Ú§Aªº´y­z±ø¥ó©R¦WÀ³¸Ó´N¨S¿ù

Hsieh

¦^´_ 20# jackyliu

¤â°Ê§R°£µ{¦¡½X¥t¦s·sÀÉ´N¦n°Õ
­n¦Û°Ê¥t¦s®É§R°£µ{¦¡½X¡A¥i§Q¥ÎBEFORE_SAVE¨Æ¥ó§¹¦¨(¦pªþ¥ó)
insert_pictures.rar (1.74 MB)

¤U¸ü¦¸¼Æ: 28

2011-2-23 08:23