ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¥»©«³Ì«á¥Ñ li918272002 ©ó 2012-10-9 17:11 ½s¿è

¤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

¦^´_ 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)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-10-13 15:33 ½s¿è

¦^´_ 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)

´¡¤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

TOP

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

TOP

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

  ¦h°µ¦h·Q¦h¾Ç²ß¡A¤Ö¬Ý¤Ö¿ù¤Ö°g³~

  ¦h°µ=¦h¦h½m²ß¡A¦h¦h½s¼g¡C
  ¦h·Q=·Q·Q¬°¤°»ò¤H®aµ{¦¡­n¨º¼Ë¼g¡A¦pªG´«¦¨¦Û¤v¡A¤S·|«ç¼g¡C
  ¦h¾Ç²ß=¾Ç²ß¤H®aªºµo°Ý¨Ã¸Ñµª¡A¾Ç²ß¤H®aªº¼gªk

  ¤Ö¬Ý=¥u¬Ý¤£°µ¤]ªPµM

TOP

        ÀR«ä¦Û¦b : ¯u¥¿ªº·R¤ß¡A¬O·ÓÅU¦n¦Û¤vªº³oÁû¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD