返回列表 上一主題 發帖

複製的問題

分頁另存檔案,直接在開啟檔案所在位置另存新檔


Sub SaveSheet()
'以下程式碼試用 Excel 200~2010版
Dim wks As Worksheet
    Set wks = ActiveSheet
    With wks
        If Val(Application.Version) < 12 Then
            'Excel 版本 97-2003
            'xlWorkbookNormal -4143 一般活頁簿
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case .Parent.FileFormat
                'xlOpenXMLWorkbook 51 開啟 XML 活頁簿
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .Parent.HasVBProject Then
                    'xlOpenXMLWorkbookMacroEnabled 52 開啟 XML 活頁簿巨集啟用
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            End Select
        End If
        .Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs .Parent.Path & "\" & .Name & FileExtStr, FileFormatNum
        Application.DisplayAlerts = True
        ActiveWorkbook.Close SaveChanges:=False
    End With
End Sub
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題