[µo°Ý] ExcelÀɮ׸ê®Æ§ó·s´£¥Ü

li918272002

¤j®a¦n¡A­è±µÄ²VBA¤£¤[¡Aºô¸ô¤W§ä¤F¦n¦h¤å³¹,¤]¦b¦¹ª¦¤F«Ü¦h¤åÁÙ¬O¤£ª¾¸Ó«ç»ò§¹¦¨§Ú·Q­nªº¥\¯à¡C¥i§_½Ð±Ð¦U¦ì¤j®v!!

§Ú·Q­n°µ¤@­Ó¥\¯à,¥i¥H«ö¤U¤@­Ó«ö¶s¡A¦Û°Ê¥hÀˬd¸ê®Æ§¨¤º©Ò¦³ExcelÀɮ׸̬O§_¦³§ó·s¸ê®Æ,¦pªG¦³Åã¥Ü¥X¦³´Xµ§§ó·s¸ê®Æ!!
¤£¾å±o¯à°÷°µ¨ì¶Ü¡H·Q¤F¦n¤[,ÁÙ¬O°µ¤£¥X¨Ó¡C

³Â·Ð¤j®aÀ°­Ó¦£,ÁÂÁ¡C

mark15jill

Excel 2010
¤W¤è¤u¨ã¦C ¡÷ ®Õ¾\ ¡÷ Åܧó¤º

hsiehth

­ì¨ÓÁÙ¦³³oºØ¤è¦¡
¯u¬O¾Ç¨ì¤F

GBKEE

¦^´_ 1# li918272002
¥ý¦³¬ö¿ý,¤~¥i¬d¬Ý
·s¶}Àɮפ¤, ½Æ»s¤U¦C¤T­Ó¼Ò²Õ, ¦s¬°¼W¯q¶°ÀÉ®×, ¸ü¤J¦¹¼W¯q¶°ÀÉ®×
º¸«áExcel¤¤¶}±Ò¤w¦sÀɪºÀÉ®× ¥i¦s¤U­×§ï°O¿ý

test.rar (26.17 KB)

¤U¸ü¦¸¼Æ: 8

2012-10-13 15:25

´¡¤J ªí³æ(¦WºÙ UserForm1 )ªºµ{¦¡½X   ¶·¦³±±¨î¶µ ComboBox1,ListBox1,ListBox2

1. '´¡¤J ¤@ªí³æ(¦WºÙ UserForm1 )ªºµ{¦¡½X   ¶·¦³±±¨î¶µ ComboBox1,ListBox1,ListBox2
   
2. Option Explicit
   
3. Dim xlFile As String
   
4. Private Sub ComboBox1_Change()
   
5.     If ComboBox1.ListIndex > -1 Then
   
6.         Åª¨ú°lÂÜÀÉ
   
7.     Else
   
8.         ListBox1.Clear
   
9.     End If
   
10. End Sub
    
11. Private Sub UserForm_Activate()
    
12.     xlFile = ActiveWorkbook.Path & °lÂÜÀÉ
    
13.     Caption = ActiveWorkbook.Path & °lÂÜÀÉ
    
14.     If Dir(xlFile) = "" Then
    
15.         Me.Hide
    
16.         MsgBox ActiveWorkbook.Path & " ¨S¦³Åܧ󪺸ê®Æ °lÂÜÀÉ "
    
17.         Unload Me
    
18.     Else
    
19.         ªí³æ³]©w
    
20.     End If
    
21. End Sub
    
22. Private Sub ªí³æ³]©w()
    
23.     Dim E As String
    
24.     Top = 66.95
    
25.     Left = 165.75
    
26.     Height = 343.85
    
27.     Width = 552.5
    
28.     With ListBox1
    
29.         .Top = 58.9
    
30.         .Left = 17.65
    
31.         .Height = 247.5
    
32.         .Width = 507.45
    
33.         .ColumnCount = 4
    
34.         .ColumnWidths = "90,130,130,130"
    
35.         .Font.Size = 12
    
36.     End With
    
37.     With ListBox2
    
38.         .Top = 35.35
    
39.         .Left = 17.65
    
40.         .Height = 21.95
    
41.         .Width = 507.5
    
42.         .ColumnCount = 4
    
43.         .ColumnWidths = "90,130,130,130"
    
44.         .TextAlign = fmTextAlignCenter
    
45.         .Font.Size = 16
    
46.     End With
    
47.     With ComboBox1
    
48.         .Top = 11.8
    
49.         .Left = 17.65
    
50.         .Height = 15.05
    
51.         .Width = 94.3
    
52.         E = Dir(ActiveWorkbook.Path & "\*.XLS")
    
53.         Do While E <> ""
    
54.         If E <> ThisWorkbook.Name Then
    
55.             .AddItem E
    
56.         End If
    
57.         E = Dir
    
58.         Loop
    
59.         .Value = ActiveWorkbook.Name
    
60.     End With
    
61. End Sub
    
62. Private Sub Ū¨ú°lÂÜÀÉ()
    
63.     Dim fs As Object, xlWord As Variant, I, E
    
64.     Set fs = CreateObject("Scripting.FileSystemObject")
    
65.     Set fs = fs.OpenTextFile(xlFile, 1, False)
    
66.     xlWord = fs.readall
    
67.     fs.Close
    
68.     xlWord = Split(xlWord, Chr(10))
    
69.     With ListBox2
    
70.         .Clear
    
71.         .AddItem
    
72.         For E = 0 To .ColumnCount - 1
    
73.             .List(.ListCount - 1, E) = Split(xlWord(0), ",")(E)
    
74.         Next
    
75.     End With
    
76.     With ListBox1
    
77.         .Clear
    
78.         For I = 1 To UBound(xlWord) - 1
    
79.             If InStr(xlWord(I), ComboBox1 & "]") Then
    
80.                 .AddItem
    
81.                 For E = 0 To .ColumnCount - 1
    
82.                     .List(.ListCount - 1, E) = Split(xlWord(I), ",")(E)
    
83.                 Next
    
84.             End If
    
85.         Next
    
86.     End With
    
87. End Sub

½Æ»s¥N½X

´¡¤J ¤@¯ë¼Ò²Õ (¦WºÙ¬°  Module1 ) ªºµ{¦¡½X

1. '´¡¤J ¤@¯ë¼Ò²Õ (¦WºÙ¬°  Module1 ) ªºµ{¦¡½X
   
2. Option Explicit
   
3. Public Const °lÂÜÀÉ = "\¸ê®Æ¬ö¿ýÀÉ.TXT"
   
4. Public Ar(), xlId As CommandBarControl
   
5. Dim My_App As New Class1
   
6. Private Sub AUTO_CLOSE()
   
7.     Application.CommandBars.ActiveMenuBar.Reset
   
8. End Sub
   
9. Private Sub AUTO_Open()
   
10.     ª«¥ó³]©w
    
11.     ·s¼W«ü¥O
    
12. End Sub
    
13. Private Sub ª«¥ó³]©w()
    
14.     Set My_App.APP = Application
    
15. End Sub
    
16. Private Sub ·s¼W«ü¥O()
    
17.     With Application.CommandBars.ActiveMenuBar
    
18.         .Reset                   '­«³]  ¥\¯àªí
    
19.         With .Controls.add(10, , , , True) 'msoControlPopup
    
20.             .Caption = "°lÂÜ«ü¥O(&P)"
    
21.             .TooltipText = "«ö Alt + P"
    
22.             Set xlId = .Controls.add(1)     'msoControlButton
    
23.             With xlId
    
24.                 .Caption = "¸ê®Æ¬ö¿ýÀÉ(&C)"
    
25.                 .OnAction = "°lÂÜ«ü¥O"
    
26.                 .TooltipText = "«ö Alt + C"
    
27.             End With
    
28.             With .Controls.add(1)           'msoControlButton
    
29.                 .Caption = "«ü¥O­«³](&R)"
    
30.                 .OnAction = "AUTO_Open"
    
31.                 .TooltipText = "«ö Alt + R"
    
32.             End With
    
33.         End With
    
34.     End With
    
35.     MakeAr
    
36. End Sub
    
37. Sub °lÂÜ«ü¥O()
    
38.     UserForm1.Show
    
39. End Sub
    
40. Private Sub MakeAr()  '¨ú±o¤u§@ªí¸ê®Æ
    
41.     Dim ArCell As String, Msg As Boolean
    
42.    If Workbooks.Count = 0 Then
    
43.         Msg = True
    
44.    ElseIf ActiveWorkbook.Name = ThisWorkbook.Name Or ActiveWorkbook.Path = "" Then
    
45.         Msg = True
    
46.    ElseIf Dir(ActiveWorkbook.Path & °lÂÜÀÉ) = "" Then
    
47.         Msg = True
    
48.     End If
    
49.     If Msg = True Then
    
50.         xlId.Enabled = False        '°±¤î ¸ê®Æ¬ö¿ýÀÉ
    
51.         Exit Sub
    
52.     Else
    
53.         xlId.Enabled = True         '«ì´_ ¸ê®Æ¬ö¿ýÀÉ
    
54.     End If
    
55.     ArCell = Range("A1:" & Cells.SpecialCells(xlCellTypeLastCell).Address).Address
    
56.     On Error Resume Next
    
57.     Ar = Application.Transpose(Range(ArCell).Value)
    
58.     If Err.Number > 0 Then
    
59.         ReDim Ar(1, 1)
    
60.         Err.Clear
    
61.     End If
    
62. End Sub

½Æ»s¥N½X

´¡¤J ª«¥óÃþ§O¼Ò²Õ(¦WºÙ Class1 ) ªºµ{¦¡½X

1. '´¡¤J ª«¥óÃþ§O¼Ò²Õ(¦WºÙ Class1 ) ªºµ{¦¡½X
   
2. Option Explicit
   
3. Public WithEvents APP As Application
   
4. Private Sub APP_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
5.     Dim xlErr As Integer, xlUsed As String
   
6.     If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
   
7.     If ActiveWorkbook.Path = "" Then
   
8.         MsgBox ActiveWorkbook.Name & "  ¥¼¦sÀÉ ½Ð¥ý¦sÀÉ !"
   
9.         Exit Sub
   
10.     End If
    
11.     xlUsed = Application.UserName
    
12.     On Error GoTo R
    
13.     If Target(1).Row <= UBound(Ar, 2) And Target(1).Column <= UBound(Ar, 1) And Ar(Target(1).Column, Target(1).Row) <> "" Then
    
14.         ¬ö¿ý°lÂÜ Format(Now, "YYYY/MM/DD HH:NN:SS") & "," & Target(1).Address(0, 0, , 1, 1) & "," & Ar(Target.Column, Target(1).Row) & "," & Target(1).Value & "," & Application.UserName
    
15.     Else
    
16.         ¬ö¿ý°lÂÜ Format(Now, "YYYY/MM/DD HH:NN:SS") & "," & Target(1).Address(0, 0, , 1, 1) & ",," & Target(1) & " ," & Application.UserName
    
17.     End If
    
18. R:
    
19.     xlErr = Err.Number
    
20.     Run "Module1.MakeAr" 'MakeAr
    
21.     If xlErr <> 0 Then
    
22.         If Dir(ActiveWorkbook.Path & °lÂÜÀÉ) = "" Then
    
23.             ¬ö¿ý°lÂÜ Format(Now, "YYYY/MM/DD HH:NN:SS") & "," & Target(1).Address(0, 0, , 1, 1) & "," & Target(1) & ", ," & Application.UserName
    
24.             xlId.Enabled = True
    
25.         Else
    
26.             ¬ö¿ý°lÂÜ Format(Now, "YYYY/MM/DD HH:NN:SS") & "," & Target(1).Address(0, 0, , 1, 1) & "," & Ar(Target.Column, Target(1).Row) & ", ," & Application.UserName
    
27.         End If
    
28.     End If
    
29.     Err.Clear
    
30.     Sh.Parent.Save
    
31. End Sub
    
32. Private Sub APP_SheetActivate(ByVal Sh As Object)
    
33.     Run "Module1.MakeAr" 'MakeAr
    
34. End Sub
    
35. Private Sub APP_WorkbookActivate(ByVal Wb As Workbook)
    
36.     Run "Module1.MakeAr" 'MakeAr
    
37. End Sub
    
38. Private Sub ¬ö¿ý°lÂÜ(xlWord As String)     '¬ö¿ýÅܧ󪺸ê®Æ
    
39.     Dim fs As Object, xltxt As String, xlFile As String
    
40.     xlFile = ActiveWorkbook.Path & °lÂÜÀÉ
    
41.     xltxt = Dir(xlFile)
    
42.     Set fs = CreateObject("Scripting.FileSystemObject")
    
43.     Set fs = fs.OpenTextFile(xlFile, 8, True)
    
44.     If xltxt = "" Then
    
45.     fs.WriteLINE "¤é´Á,¦ì¸m,­ì¥»,Åܧó,­×§ïªÌ"
    
46.     End If
    
47.     fs.WriteLINE xlWord
    
48.     fs.Close
    
49. End Sub
    
50. Private Sub APP_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    
51. If Wb.Name <> ThisWorkbook.Name Then Run "Module1.MakeAr"   'MakeAr
    
52. End Sub
    
53. Private Sub APP_WorkbookOpen(ByVal Wb As Workbook)
    
54. Run "Module1.MakeAr" 'MakeAr
    
55. End Sub

½Æ»s¥N½X

luhpro

¦^´_ 1# li918272002
§Ú¯à·Q¨ìªº¦³¨âºØ¤èªk:
1. ¨C­ÓExcelÀɮפ¤§@¸ê®Æ²§°Ê®É´N±N¬ÛÃö¸ê®Æ¼g¨ì¤@­ÓÀɮפ¤,»Ý­n®É¦A¥h¸ÓÀɮ׬d¸ß.
ÀuÂI¬O­n¦s¤°»ò¸ê®Æ¦Û¤v¥i¥H¨M©w
¯ÊÂI¬O¤@¤Á³£­n¦Û¤v¨Ó°µ

2. §Q¥Î Excel ªº°lÂÜ­×­q¥\¯à (¦]¬°§Ú¨S¥Î¹L, ©Ò¥H¥u¯à§iª¾¦b­þ¥i¬Ý¨ì, ¦Ü©ó¥\¯à´N­n§A¦Û¤v´ú¸ÕÅo)
¤u¨ã->°lÂÜ­×­q->¼Ð¥Ü­×­q³B (§Ú¨Ï¥Î Excel 2003 ª©, ­Y¬O¤£¦Pª©¥»»Ý­n§A¦Û¤v¦A§ä¤@¤U³Q·L³n·h¨ì­þ¸Ì¥h¤F)