Excel的VBA另存爲功能腐敗文件

當我嘗試保存我的文件與ActiveWorkbook.Save功能。該文件得到損壞，我不能再使用它了。Excel的VBA另存爲功能腐敗文件

我已經嘗試過了ActiveWorkbook.SaveCopyAs功能，但結果是一樣的。下面的例子。我添加了底部使用的2個其他功能。

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

功能CheckPublished（）

Function CheckPublished() As Boolean 

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

和NOUPDATE：

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

來源

2017-09-05 Andries

什麼是'轉到einde'，我不認爲你添加一個「.XLSM」到您的文件，因此將其保存沒有擴展名 – Tom

湯姆嗨，在轉到Einde調用上面的最後一個函數（ UpdateAgain），thisworkbook.name得到函數包括擴展 – Andries

此外，如果工作簿尚未保存，這是運行在此之前，它會嘗試拯救'\ Book1'將理解翻倒 – Tom

通過使用工作簿的名稱比ra熱身工作簿我能解決問題;其餘的代碼是相同的，所以其餘的都沒有引起任何問題。

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

來源

2017-09-06 10:28:20 Andries

Excel的VBA另存爲功能腐敗文件

回答

相關問題