CODEWITHSUNDEEP
excelvba
codenewb
codenewb

Reputation: 75

Exporting sheet as new workbook but deleting buttons first works but also generates an error

I wrote a macro that is tied to a button to export an excel sheet to a new workbook and save it. The macro deletes all the buttons before it saves. The macro works, the sheet is generated and saved, but before it closes I get an error and I can't figure out why!

Sub Export_IssuesLog()

Dim answer As Integer
Dim PathName As String

answer = MsgBox("Do you want to export the issues log?" _
& Chr(13) & Chr(13) & Chr(10) & "Note: This macro automatically overwites versions with the same Revision Number. Please ensure the revision number is updated correctly.", vbQuestion + vbYesNo)

  If answer = vbYes Then
  
        PathName = ThisWorkbook.Path & "\" & Range("Proj_no").Value & "_" & Range("Client_short").Value & "_" & Range("Facility_short").Value & "_IssuesLog_REV-" & Range("B4").Value & ".xlsx"
        
        ActiveSheet.Copy
        
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        
        ActiveWorkbook.SaveAs Filename:=PathName
        ActiveWorkbook.Close SaveChanges:=False
        
  Else
    Exit Sub
    
  End If

End Sub

If I remove this piece of code, which does successfully delete the buttons, the macro works perfectly.

        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next

If I do include that bit of code the error it gives me is on the ActiveWorkbook.SaveAs line. It gives me a Run-time error '1004' - Method 'SaveAs' of object '_workbook' failed.

The thing is, it does actually save the workbook! I can't figure out what I'm doing wrong!

Upvotes: 2

Views: 84

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Referencing Objects

  • Use Option Explicit.
  • Try referencing all objects one at a time i.e. use variables.
Option Explicit

Sub ExportIssuesLog()

    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    ' Make sure the workbook is active, or the ranges will fail.
    If Not swb Is ActiveWorkbook Then swb.Activate
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    Dim sws As Worksheet: Set sws = ActiveSheet
    
    Dim dPath As String: dPath = swb.Path & "\" & Range("Proj_no").Value _
        & "_" & Range("Client_short").Value & "_" _
        & Range("Facility_short").Value & "_IssuesLog_REV-" & Range("B4").Value
    
    Dim Answer As Long
    Answer = MsgBox("Do you want to export the issues log?" _
        & Chr(13) & Chr(13) & Chr(10) & "Note: This macro automatically " _
        & "overwites versions with the same Revision Number. " _
        & "Please ensure the revision number is updated correctly.", _
        vbQuestion + vbYesNo)
    If Answer = vbNo Then Exit Sub ' canceled
    
    sws.Copy
    
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    Dim dws As Worksheet: Set dws = dwb.Sheets(1)
        
    Dim shp As Shape
    For Each shp In dws.Shapes
        If shp.AutoShapeType = msoShapeStyleMixed Then shp.Delete
    Next shp
    
    Application.DisplayAlerts = False ' overwrite without conpfirmation
        dwb.SaveAs Filename:=dPath
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False
    
    MsgBox "Issues Log exported.", vbInformation
    
End Sub

Upvotes: 2

Related Questions