代码之家 › 专栏 › 技术社区 › Andries

Excel VBA另存为函数损坏文件

vba save-as save excel

Andries · 技术社区 · 9 年前

我已经试过ActiveWorkbook了。SaveCopyAs函数,但结果相同。下面是示例。我在底部添加了另外两个功能。

Sub Publish_WB()
Dim ws As Worksheet

Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String

If CheckPublished() Then
    MsgBox ("Published version, feature not available ...")
    Exit Sub
End If

NoUpdate
PublishInProgress = True

'Save the Current Workbook
OriginalFname = ActiveWorkbook.Path & "\" & ThisWorkbook.Name

'Store the current path
CurrentPath = CurDir

'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path

NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")

FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
    ActiveWorkbook.SaveAs FName, 52
    ActiveWorkbook.SaveCopyAs (OriginalFname)
Else
    'user has cancelled
    GoTo einde
End If

Function CheckPublished() As Boolean

If Range("Quoting_Tool_Published").Value = True Then
    CheckPublished = True
Else
    CheckPublished = False
End If
End Function

最新消息:

Sub NoUpdate()
If NoUpdateNested = 0 Then
    CurrentCalculationMode = Application.Calculation 'store previous mode
End If

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    'Application.Cursor = xlWait


    NoUpdateNested = NoUpdateNested + 1
   ' Debug.Print "NoUpdate, Noupdatenested = " & NoUpdateNested

End Sub

如果我们跳转到einde,我调用以下函数:

Sub UpdateAgain()

NoUpdateNested = NoUpdateNested - 1

If NoUpdateNested < 1 Then
    Application.Calculation = xlCalculationAutomatic 'let all sheets be calculated again first
    Application.Calculation = CurrentCalculationMode 'set to previous mode
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Cursor = xlDefault
Else
    Application.Calculation = xlCalculationAutomatic 'recalculate sheets, but keep the rest from updating
    Application.Calculation = xlCalculationManual
End If

'Debug.Print "UpdateAgain, Noupdatenested = " & NoUpdateNested

End Sub

1 回复 | 直到 8 年前

Andries 9 年前

通过使用工作簿而不是activeworkbook的名称,我能够解决这个问题;代码的其余部分是相同的,因此其余部分没有引起任何问题。

Sub Publish_WB()
Dim ws As Worksheet
Dim wb as Workbook


Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String

If CheckPublished() Then
    MsgBox ("Published version, feature not available ...")
    Exit Sub
End If

NoUpdate
PublishInProgress = True

'Save the Current Workbook
Set wb = ThisWorkbook
wb.Save

'Store the current path
CurrentPath = CurDir

'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path

NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")

FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
    wb.SaveAs FName, 52
Else
    'user has cancelled
    GoTo einde
End If