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

[µo°Ý] ¦p¦ó³z¹L VBA»yªk ¶}±Ò±M®×ªº±K½X

¥»©«³Ì«á¥Ñ jsleee ©ó 2012-8-8 21:53 ½s¿è

¦^´_ 8# Hsieh


    ½Ð±Ð¶W¯Åª©¥D Hsieh
        §Ú¦b 10# ©Ò´£ªº°ÝÃD¤£ª¾¹D¦³µL¸Ñ¡H
        ¥Ø«e¨Ï¥Î°j°é¶}±Ò¦P¤@¥Ø¿ý¤¤ªº¦h­ÓÀɮסA
        ³£¥u¦³¨ä¤¤¤@­ÓÀÉ®×¥i¥H¥¿±`¶}±Ò±M®×±K½X¡A
        ¨ä¾lÀɮ׳£¥u¦³¶}±ÒExcelÀÉ¡A±M®×±K½X¨S¦³¶}±Ò¡H¡H¡H
        (ps. ¨C¤@­ÓÀɮתºÀÉ®×±K½X & VBA±M®×±K½X³£¬O¤@¼Ëªº....)
        §Æ±æ¶W¯Åª©¥D¯à°÷¼·ªÅ¸Ñ´b¡AÁÂÁÂ
JS

¦Û°Ê¶}Àɵ{¦¡test.rar (13.31 KB)

TOP

  1. Sub ¶}±ÒÀÉ®×()
  2.     Dim CurrentPath As String   'Àx¦s¥Ø«eÀɮץؿý
  3.     Dim OpenFN As String   'Ū¨ú¨ìªºÀɮצWºÙ
  4.     Dim FNExt As String    'ÀÉ®×°ÆÀɦW
  5.     Dim MyBook As Workbook
  6.     FN = ActiveWorkbook.Name

  7.     CurrentPath = Range("B1")   '¦pªG¦³³]©w¥H³]©w¬°¥D
  8.     FNExt = Range("b2")   '¬d¸ßÀÉ®×Ãþ«¬
  9.     If Trim(CurrentPath) = "" Then
  10.        CurrentPath = Excel.ActiveWorkbook.Path
  11.     End If
  12.    
  13.     n = 0
  14.     Sheets("trans").Cells.Delete  '±N¤§«eªºµ²ªG²M°£
  15.     If Right(CurrentPath, 1) = "\" Then
  16.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
  17.         OpenFNTime = CurrentPath
  18.     Else
  19.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
  20.         OpenFNTime = CurrentPath & "\"
  21.     End If
  22.    
  23.     While OpenFN <> ""
  24.         If OpenFN <> ActiveWorkbook.Name Then '³o­ÓÀɮפ£­nÅã¥Ü
  25.             If OpenFN <> "." And OpenFN <> ".." Then
  26.                 n = n + 1
  27.                 fs = OpenFNTime & OpenFN
  28.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  29.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  30.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  31.        Pwd = "1234" '¦Û¦æ­×§ï±K½X
  32.        SendKeys Pwd & "~"
  33.        Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
  34.             End If
  35.         End If
  36.         OpenFN = Dir() 'Ū¨ú¤U¤@­ÓÀÉ®×
  37.     Wend
  38.    
  39.     Workbooks(FN).Close savechanges:=False
  40. End Sub
½Æ»s¥N½X
¦^´_ 11# jsleee
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 12# Hsieh


    ¤£¦n·N«ä¡A¦A½Ð±Ð ¶W¯Åª©¥D....
    §Ú±Nµ{¦¡½X½Æ»s¨ìÀɮפ¤¡AµM«á­×¸Ó±K½X«á¡A°õ¦æ¨ì ²Ä 34¦æ¡A
       Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
    ´N·|¥X²{¿ù»~°T®§ "°õ¦æ¶¥¬q¿ù»~ '91' ¡A¨S¦³³]©wª«¥óÅܼƩΠWith °Ï¶ôÅܼÆ"¡H¡H¡H
    ¥t¥~½Ð±Ð¡A¤W­zµ{¦¡½X34¦æ ¤¤¡A©Ò¥Nªíªº§t·N¬O¬Æ»ò¡H
    CommandBars(16) ¤¤ªº 16 ¦³µL¯S§O·N¸q¡H
    ID:=1561 ¤¤ªº 1561 ¦³µL¯S§O·N¸q¡H

    ¥H¤W½Ð±Ð¡AÁÂÁÂ

JS

TOP

¦^´_ 13# jsleee

³o¬O¦b2003ª©¤¤¥i¥H°õ¦æªºµ{¦¡½X
¤£¦Pª©¥»½Ð°õ¦æ¤U¦Cµ{¦¡½X
¨ú±o¹ïÀ³ID
  1. Sub nn()
  2. Dim cmb As CommandBar
  3. For Each cmb In Application.CommandBars
  4.    For Each ob In cmb.Controls
  5.    r = r + 1
  6.    Cells(r, 1).Resize(, 3) = Array(ob.Caption, cmb.Index, ob.ID)
  7.    Next
  8. Next
  9. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 14# Hsieh


    ·PÁ ¶W¯Åª©¥D ªº±Ð¾É¡A¯u¬O¥O¤H¶}¤F²´¬É....
    ­ì¨Ó VBA ÁÙ¦³³o»ò¦hÄ_ÂáA¯u¬O°ª²`²ö´ú....

     ¥t¥~¤@­Ó°ÝÃD¡A§Ú¦b´ú¸Õªº¹Lµ{¡A°¸º¸·|¦³ Sendkeys ¥¢®Äªºª¬ªp (§Ú²q´úªº)
     ¦]¬° ´ú¸Õ³sÄò¶}±Ò¥Ø¿ý¤¤ 7 ­ÓÀɮסA¨ä¤¤´Nµo¥Í ¤T­ÓÀɮ׻ݭn¤H¤u¿é¤J VBA±M®×±K½X¡H¡H¡H
     ½Ð°Ý³o¼Ë¥¿±`¶Ü¡H
     ¬O§_¦]¬° Sendkeys °õ¦æ¹Lµ{®É¶¡®t°ÝÃD¾É­P ±K½X¨S¦³ send ¦¨¥\¡H¡H¡H
     «Ü©êºp¡AÁöµM¤@¨B¤@¨B´Â¥Ø¼ÐÁÚ¶i¡A¤£¹LÁÙ¬O¦³¹J¨ì°ÝÃD.....
      ·Ð½Ð¸Ñ´b¡AÁÂÁÂ
JS

TOP

¦^´_ 15# jsleee
SendKeys¤èªk¥[¤Wwait°Ñ¼Æ¸Õ¸Õ¬Ý
  1. Sub ¶}±ÒÀÉ®×()
  2.     Dim CurrentPath As String   'Àx¦s¥Ø«eÀɮץؿý
  3.     Dim OpenFN As String   'Ū¨ú¨ìªºÀɮצWºÙ
  4.     Dim FNExt As String    'ÀÉ®×°ÆÀɦW
  5.     Dim MyBook As Workbook
  6.     FN = ActiveWorkbook.Name

  7.     CurrentPath = Range("B1")   '¦pªG¦³³]©w¥H³]©w¬°¥D
  8.     FNExt = Range("b2")   '¬d¸ßÀÉ®×Ãþ«¬
  9.     If Trim(CurrentPath) = "" Then
  10.        CurrentPath = Excel.ActiveWorkbook.Path
  11.     End If
  12.    
  13.     n = 0
  14.     Sheets("trans").Cells.Delete  '±N¤§«eªºµ²ªG²M°£
  15.     If Right(CurrentPath, 1) = "\" Then
  16.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
  17.         OpenFNTime = CurrentPath
  18.     Else
  19.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
  20.         OpenFNTime = CurrentPath & "\"
  21.     End If
  22.    
  23.     While OpenFN <> ""
  24.         If OpenFN <> ActiveWorkbook.Name Then '³o­ÓÀɮפ£­nÅã¥Ü
  25.             If OpenFN <> "." And OpenFN <> ".." Then
  26.                 n = n + 1
  27.                 fs = OpenFNTime & OpenFN
  28.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  29.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  30.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  31.        Pwd = "1234" '¦Û¦æ­×§ï±K½X
  32.        SendKeys Pwd & "~", True
  33.        Application.CommandBars(16).FindControl(ID:=1561, recursive:=True).Execute
  34.             End If
  35.         End If
  36.         OpenFN = Dir() 'Ū¨ú¤U¤@­ÓÀÉ®×
  37.     Wend
  38.    
  39.     Workbooks(FN).Close savechanges:=False
  40. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 16# Hsieh


    ¤£¦n·N«ä¡A´ú¸Õµ²ªGµL®Ä....

TOP

¦^´_ 17# jsleee

¬O¬Y¨Ç©T©wÀÉ®×·|µo¥Í³o¼Ëªº±¡§Î¶Ü?
¦pªG¬O¡A§Ú²q¥i¯à¬OÀɮ׶}±Ò®É¶¡¸ûªø
µ²ªGµ{¦¡¥ý¶]¨ìÀ˵øµ{¦¡½X¡AµM«á¤~§¹¦¨Àɮ׶}±Ò
¸Õ¸Õ¥Îsleep°±¹y¼Æ¬í«á¦AÄ~Äò©¹¤U°õ¦æ¸Õ¸Õ¬Ý¬O§_¦³§ïµ½
  1. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  2. Sub ¶}±ÒÀÉ®×()
  3.     Dim CurrentPath As String   'Àx¦s¥Ø«eÀɮץؿý
  4.     Dim OpenFN As String   'Ū¨ú¨ìªºÀɮצWºÙ
  5.     Dim FNExt As String    'ÀÉ®×°ÆÀɦW
  6.     Dim MyBook As Workbook
  7.     FN = ActiveWorkbook.Name

  8.     CurrentPath = Range("B1")   '¦pªG¦³³]©w¥H³]©w¬°¥D
  9.     FNExt = Range("b2")   '¬d¸ßÀÉ®×Ãþ«¬
  10.     If Trim(CurrentPath) = "" Then
  11.        CurrentPath = Excel.ActiveWorkbook.Path
  12.     End If
  13.    
  14.     n = 0
  15.     Sheets("trans").Cells.Delete  '±N¤§«eªºµ²ªG²M°£
  16.     If Right(CurrentPath, 1) = "\" Then
  17.         OpenFN = Dir(CurrentPath & FNExt, vbDirectory)
  18.         OpenFNTime = CurrentPath
  19.     Else
  20.         OpenFN = Dir(CurrentPath & "\" & FNExt, vbDirectory)
  21.         OpenFNTime = CurrentPath & "\"
  22.     End If
  23.    
  24.     While OpenFN <> ""
  25.         If OpenFN <> ActiveWorkbook.Name Then '³o­ÓÀɮפ£­nÅã¥Ü
  26.             If OpenFN <> "." And OpenFN <> ".." Then
  27.                 n = n + 1
  28.                 fs = OpenFNTime & OpenFN
  29.                 Workbooks(FN).Sheets("trans").Cells(n, 7).Value = fs
  30.                 Workbooks.Open(Filename:=OpenFNTime & OpenFN _
  31.        , Password:="msign").RunAutoMacros Which:=xlAutoOpen
  32.        Sleep 200 '¼È°±2¬í
  33.        Pwd = "1234" '¦Û¦æ­×§ï±K½X
  34.        CId = IIf(Application.Version = 11, 16, 42)
  35.        Set vbProj = ActiveWorkbook.VBProject
  36.        If vbProj.Protection <> 1 Then GoTo 10
  37.        SendKeys Pwd & "~", True
  38.        Application.CommandBars(CId).FindControl(ID:=1561, recursive:=True).Execute
  39.             End If
  40.         End If
  41. 10
  42.         OpenFN = Dir() 'Ū¨ú¤U¤@­ÓÀÉ®×
  43.     Wend
  44.     SendKeys "%{F11}" 'Â÷¶}VBE
  45.    ' Workbooks(FN).Close savechanges:=False
  46. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 18# Hsieh


    ¶W¯Åª©¥D±z¦n
            ´ú¸Õ¦n´X¦¸³£¥¢±Ñ¡A±K½X·|³Q¶Ç°e¨ì¤u§@ªí¤¤¡AµLªk°e¨ì VBA±M®×±K½X ªº¹ï¸Ü®Ø....
            ¥t¥~½Ð±Ð¡APublic Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
            ³o¤@¦æ«Å§i ¤£¤Ó¤F¸Ñ¥Lªº·N«ä¡H¦]¬° Sleep ªº¥\¯à¦n¹³¨S¦³·Pı¨ì....

JS

TOP

        ÀR«ä¦Û¦b : ¯à¥I¥X·R¤ß´N¬OºÖ¡A¯à®ø°£·Ð´o´N¬O¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD