Excel VBA Saveas関数がファイルを破損しています

Question

ActiveWorkbook.Save関数でファイルを保存しようとします。ファイルgetは壊れていて、もう使用できません。

私はすでにActiveWorkbook.SaveCopyAs関数を試しましたが、結果は同じです。この例の下に。私は底に使用されている2つの他の関数を追加しました。 CheckPublished

は

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 

と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 

Answer 1

使用することによりワークブックの名前はraよりも私は問題を解決することができました。残りのコードは同じなので、残りの部分は問題を引き起こしていませんでした。

`後藤einde`が何であるかを

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