Hsieh

¦^´_ 22# jackyliu

thisworkbook¼Ò²Õ

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2. If SaveAsUI = True And Cancel = False Then
   
3. Dim vbc As Object
   
4. With ThisWorkbook.VBProject
   
5. For Each vbc In .VBComponents
   
6.   Select Case vbc.Type
   
7.   Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm 'µù
   
8.     .VBComponents.Remove .Item(vbc.Name)
   
9. 
   
10.   Case Else
    
11.     .VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
    
12.     .VBComponents(vbc.Name).CodeModule.CountOfLines
    
13. 
    
14.   End Select
    
15. Next
    
16. End With
    
17. End If
    
18. End Sub
    
19. 
    
20. 
    
21. Private Sub Workbook_Open()
    
22. Set d = CreateObject("Scripting.Dictionary")
    
23. fd = ThisWorkbook.Path & "\" '¹ÏÀɥؿý
    
24. fs = Dir(fd & "*.jpg")
    
25. Do Until fs = ""
    
26. If InStr(fs, "-") = 0 Then '¥u¦³¼Æ­È
    
27.    d(fs) = "H" & Val(fs) + 2 '¦]¬°¦b²Ä¦C©Ò¥H¥[2
    
28.    ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '¥u¦³1­Ó¤À¹j²Å¸¹
    
29.    '²Ä2½X¬°C´N¬OIÄæ¡A§_«h´N¦bJÄæ
    
30.    V = Split(fs, "-")(1)
    
31.      If Split(fs, "-")(1) Like "C*" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
32.    Else
    
33.    '²Ä3½X¬O1´N¦bKÄæ¡A2´N¦bLÄæ¡A¨ä¾l¦bMÄæ
    
34.    ar = Split(fs, "-")
    
35.    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
    
36.    k = Chr(Val(ar(2)) * 2 + p) '¦r¦êÅܼÆkªº­È¬O²Ä3½X+p¹ïÀ³¨ìªº¦r¦ê(´N¬OÄæ¦ì)
    
37.    d(fs) = k & Val(fs) + 2
    
38. End If
    
39. fs = Dir
    
40. Loop
    
41. With Sheets("Sheet1")
    
42. .Pictures.Delete '²M°£©Ò¦³¹Ï¤ù
    
43. Application.ScreenUpdating = False
    
44. For Each ky In d.keys
    
45.    Set A = .Range(d(ky)) '¹Ï¤ù´¡¤Jªº¦ì¸m
    
46.       With .Pictures.Insert(fd & ky) '´¡¤J¹ÏÀÉ
    
47.          .ShapeRange.LockAspectRatio = msoFalse '¸Ñ°£ªø¼e¤ñ¨Ò
    
48.          .Top = A.Top
    
49.          .Left = A.Left
    
50.          .Height = A.Height
    
51.          .Width = A.Width
    
52.        End With
    
53. Next
    
54. End With
    
55. Application.ScreenUpdating = True
    
56. End Sub

½Æ»s¥N½X

jackyliu

ª©¤j  §ÚÅv­­ÁÙ¤Ó¤p, ©Ò¥H±zªºrar ªþ¥óÀÉ , µLªk¤U¸ü....
¥i§_©ú¥Ü~ ~

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

jackyliu

©Ò¥H µ{¦¡¥iŪ¨ì¹Ï¤ù¦WºÙ200.jpg ©Î¬O200-C-0.jpg ,©Ò¥H¬O¨S¦³¤ñ¼Æ­­¨î...

¥t¥~..¹Ï¤ù´¡¤J«á,¥t¦s·sÀÉ®É,·sÀx¦sªºÀÉ®×,·|Áp±aVBA  µ{¦¡Code ±a¦Ü ·sÀÉ®×­C;
¥i§_¥t¦sÀÉ®×®É ,¤£­n¤]±NVBA  µ{¦¡Code ¦s¨ì·sÀÉ®× ( ·sÀɮפ£­n¦³ VBA  µ{¦¡Code ) ­n¦p§@ ?

¤°»ò¤è¦¡³£¥i¥H ,³Â·Ð «ü±Ð¤@¤U !

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¿ù

jackyliu

­C ... ·Pı¹ï¤F­C~
ªO¤j  ·P®¦

¤£ª¾¹D ¥i´¡¤J¨ì200.jpg ©Î¬O200-C-0.jpg µ{¦¡code ­þ¸Ì ¥i¥H¬Ý¥X¨Ó? ¦³­­¨î¶Ü?
­Y¬O­n¶}±Òexecl ´Nª½±µ±Ò°Ê¥¨¶° (¶}±Òexecl ¹Ï¤ù´N¦Û°Ê´¡¤J,­n¥[¤°»ò«ü¥O;Áٻݭn±Nµ{¦¡©ñ¦b¼Ò²Õ¸Ì¶Ü?)

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

jackyliu

ª©¤j ¥Ø«e´ú¸Õ 11±i¹Ï¤ù ,À³¸Ó·|¤À§O®t¤J 11­Ó Àx¦s®æ (H Äæ~RÄæ)
µ²ªG µo²{ ¦³¨Ç¹Ï¤ù ­«Å|±¡¦æ,¤£ª¾­þ¸Ì¥X¿ù¤F?
½Ð±z À°¦£´ú¸Õ¤@¤U, ·PÁÂ~

¦pªþ¥ó!

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

jackyliu

[attach]4793[/attach]¨Æ¥Ñ: ¦]ÀÉÀɦW¦³ 1-C-0, 1-C-1, 1-T-1 , 1-T-2 .....   ;»Ý¤À§O´¡¤J¦ÜKÄæ~RÄæ

§Ú·Q»¡§ï¦¨ ²Ä3½X½s½X¦¨0~7 ,¤À§O´¡¤J¦ÜKÄæ~RÄæ, ©Ò¥H©¹©³¤U³o¤@¦æ°Ê¤â,¤@ª½µLªk°õ¦æ,¤£ª¾¹D¬°¤°»ò¤£¦æ?
§ïªk -->IIf(Split(fs, "-")(8) = 0, "K",IIf(Split(fs, "-")(8) = 1, "L",IIf(Split(fs, "-")(8) = 2, "M",IIf(Split(fs, "-")(8) = 3, "N", "O"))
¤W­±¬O­þ¥X¿ù¤F,¥i§_À°¦£¤@¤U ! ÁÂÁ !


­ìµ{¦¡Code:
k = IIf(Split(fs, "-")(2) = 1, "K", IIf(Split(fs, "-")(2) = 2, "L", "M"))-->²Ä3½X¬O1´N¦bKÄæ¡A2´N¦bLÄæ¡A¨ä¾l¦bMÄæ

¹Ï¤ù»¡©ú¦pªþ¹Ï