VBA code - opslaan als xlsm

[Petesch2]

Beste,

Kan iemand mij helpen met de VBA code voor het opslaan van een exceldocument als xlsm bestand.

Ik zou graag het document kunnen opslaan als xlsm document met in de documentnaam de inhoud van cel C3 (naam) en de inhoud van cel C4 (geboortedatum). Dit gescheiden door een spatie.
Daarnaast zou ik graag hebben dat er eerst gecontroleerd wordt of deze documentnaam reeds bestaat en de melding krijgen of het al dan niet mag overschreven worden.

In de bijlage zit een test-documentje waarbij er een knop staat waaraan de macro zou kunnen worden toegevoegd.

Alvast bedankt voor de hulp!

 

[edmoor]

Zo bijvoorbeeld:

Sub Rechthoekafgerondehoeken1_Klikken()
    doc = ThisWorkbook.Path & "\" & Range("C3") & " " & Range("C4")
    If Dir(doc & ".xlsx") = "" Then
        Application.ScreenUpdating = False
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs doc
        ActiveWorkbook.Close
        Application.ScreenUpdating = True
    End If
End Sub

 

[snb]

Ook jouw Excel heeft een handige macrorecorder.

 

[Petesch2]

Bedankt voor het antwoord

De code blokkeert bij ActiveWorkbook.SaveAs doc
Dien ik hier nog iets aan te passen?

mvg

 

[mvdvlist]

Maak van xlsx in de code van Edmoor eens xlsm...
Niet getest.

 

[edmoor]

Werkt hier zonder enig probleem.
"blokkeert" is niet echt een technische omschrijving van wat er gebeurt.
Hij geeft dan vast een foutmelding.

 

[Petesch2]

Ik krijg volgende foutmelding

Fout 1004 tijdens uitvoering:

Methode SaveAs van object_Workbook is mislukt

 

[edmoor]

Plaats je document zoals die nu is en die fout geeft.
Mij is niet duidelijk of je nu een xlsx of een xlsm document wilt opslaan.

Kijk ook eens of dit doet wat je wilt:

Sub Rechthoekafgerondehoeken1_Klikken()
    doc = ThisWorkbook.Path & "\" & Range("C3") & " " & Range("C4") & ".xlsm"
    If Dir(doc) <> "" Then
        If MsgBox("Document bestaat al. Overschrijven?", vbQuestion + vbYesNo, "Document aanwezig") = vbNo Then Exit Sub
    End If
    
    On Error GoTo Fout
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs doc, 52
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    On Error GoTo 0
    Exit Sub
    
Fout:
    MsgBox Err.Description
End Sub

 

[Petesch2]

Beste,

Ik heb het nog eens geprobeerd met de code die je stuurde en nu werkt het goed!

bedankt!

mvg

Peter