VBA kopie opslaan zonder formules op andere locatie

[Manon22]

Hallo,

Ik heb een vba-formule gevonden om een excelbestand door op de button "opslaan" te klikken op een andere (of meerdere locaties) op te slaan en
ik heb een formule om een kopie op te slaan zonder formules (werkt dmv toewijzen aan knop).
Is er iemand die hier een combi van kan maken.

Dus een kopie van een excelbestand zonder formules opslaan door in het lint op button "opslaan" te klikken. Ik heb het zelf geprobeerd maar het is nog niet gelukt.

Sub SaveAsValues()
    Dim ws As Worksheet
     
    For Each ws In Worksheets
        ws.UsedRange = ws.UsedRange.Value
    Next ws
     
    ThisWorkbook.SaveAs "pad\bestandsnaam.xls"

End Sub


 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    On Error Resume Next
    Workbooks("pad\bestandsnaam.xlsm").SaveCopyAs Filename:="pad\bestandsnaam.xls"
    Workbooks("pad\bestandsnaam.xlsm").SaveCopyAs Filename:="pad\bestandsnaam.xls"
    If Err Then MsgBox "Er kan geen kopie gemaakt worden"
End Sub

Alvast bedankt.

Groeten Manon

 

[edmoor]

Probeer deze maar eens:

Sub SaveAsValues()
    For Each ws In ThisWorkbook.Sheets
        For Each cel In ws.UsedRange
            If cel.HasFormula Then
                cel.Value = cel
            End If
        Next cel
    Next ws
    ThisWorkbook.SaveAs "pad\bestandsnaam.xls"
End Sub

 

[Manon22]

Hoi Edmoor,

De code werkt alleen als ik in programma codes op F5 druk.

Als ik op opslaan klik doet de code het niet. En dat is wat ik graag zou willen als het mogelijk is.

Groeten Manon

 

[edmoor]

Je kan die code zo overnemen in de Workbook_BeforeSave sectie, dat lijkt me evident. Omdat je die al gebruikt was ik in de veronderstelling dat je dat wel zou weten.

Uiteraard moet je dan ook even de vraag stellen of het wel de bedoeling om zonder functies op te slaan.

 

[Manon22]

Sorry maar ik ben een vba leek. Kun je voor mij 1 code maken zodat ik die over kan nemen.
Alvast bedankt.

Groeten Manon

 

[edmoor]

Tuurlijk.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If MsgBox("Wilt u de functies vervangen door hun waarden?", vbYesNo, "Opslaan document") = vbYes Then
        For Each ws In ThisWorkbook.Sheets
            For Each cel In ws.UsedRange
                If cel.HasFormula Then
                    cel.Value = cel
                End If
            Next cel
        Next ws
    End If
End Sub

Plaats deze in de ThisWorkbook sectie.

 

[Manon22]

Daar moet neem ik aan Thisworkbook.Saveas "pad" nog bij?

 

[edmoor]

Dat kan, maar dan moet je wel ook de opdracht Cancel = True er in opnemen, anders gaat Excel nogmaals het document opslaan.

 

[Manon22]

Ik ben al een eind waarvoor dank.

Ik heb nu de volgende code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If MsgBox("Wilt u de functies vervangen door hun waarden?", vbYesNo, "Opslaan document") = vbYes Then
For Each ws In ThisWorkbook.Sheets
For Each cel In ws.UsedRange
If cel.HasFormula Then
cel.Value = cel
End If
Next cel
Next ws
ThisWorkbook.SaveAs "pad.xls"
Cancel = True
End If
End Sub

Wat er gebeurd is dat het bestand wordt opgeslagen op de aangegeven locatie wat goed is. Maar hij sluit het originele bestand zonder op te slaan. Ik zou graag willen dat ook het originele bestand wordt opgeslagen.
Tevens wordt er 2x gevraagd "Wilt u de functies vervangen door hun waarden?"


Groeten Manon

 

[edmoor]

De opdracht ThisWorkbook.SaveAs veroorzaakt opnieuw het starten van Workbook_BeforeSave. Probeer het eens zo:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If MsgBox("Wilt u de functies vervangen door hun waarden?", vbYesNo, "Opslaan document") = vbYes Then
        For Each ws In ThisWorkbook.Sheets
            For Each cel In ws.UsedRange
                If cel.HasFormula Then
                cel.Value = cel
                End If
            Next cel
        Next ws
        Application.EnableEvents = False
        ThisWorkbook.SaveAs "pad.xls"
        Application.EnableEvents = True
        Cancel = True
    End If
End Sub

 

[Manon22]

Er wordt niet meer 2x gevraagd "Wilt u de functies vervangen door hun waarden?". Dus dat is opgelost.

Het enige probleem wat er nu nog is is dat het originele bestand wordt afgesloten zonder opslaan. En ik wil graag dat het origineel ook opgeslagen wordt.
Heb je hier nog een oplossing voor.

Groeten Manon

 

[edmoor]

Die zal je dan moeten opslaan in diezelfde Sub maar voordat je de vraag stelt of de formules moeten worden vervangen.

 

[Manon22]

Hoi Edmoor,

Je weet ik ben een VBALeek. Hoe ziet wat je voorstelt er uit als je dit in de code die we tot nu toe hebben plaatst.

Groeten Manon

 

[edmoor]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    [COLOR="#FF0000"]ThisWorkbook.SaveAs "origineel.xls"[/COLOR]
    If MsgBox("Wilt u de functies vervangen door hun waarden?", vbYesNo, "Opslaan document") = vbYes Then
        For Each ws In ThisWorkbook.Sheets
            For Each cel In ws.UsedRange
                If cel.HasFormula Then
                cel.Value = cel
                End If
            Next cel
        Next ws
        Application.EnableEvents = False
        ThisWorkbook.SaveAs "pad.xls"
        Application.EnableEvents = True
        Cancel = True
    End If
End Sub

 

[Manon22]

Er wordt nu 3x gevraagd Wilt u de functies vervangen door hun waarden en niets wordt opgeslagen.
origineel niet en kopie niet.

Weet je hier nog iets voor?
Groeten Manon

 

[Manon22]

Als het helpt om de code er uit te halen "Wilt u de functies vervangen door hun waarden" is het ook geen probleem hoor.

Als het origineel en de kopie maar opgeslagen worden.
gr Manon

 

[edmoor]

Ja, ff niet bij nagedacht
En het verwijderen van de vraag wijzigt het probleem niet.

Probeer dit eens:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    ThisWorkbook.SaveAs "origineel.xls"
    If MsgBox("Wilt u de functies vervangen door hun waarden?", vbYesNo, "Opslaan document") = vbYes Then
        For Each ws In ThisWorkbook.Sheets
            For Each cel In ws.UsedRange
                If cel.HasFormula Then
                cel.Value = cel
                End If
            Next cel
        Next ws
        ThisWorkbook.SaveAs "pad.xls"
        Cancel = True
    End If
    Application.EnableEvents = True
End Sub

 

[snb]

@Ed

Oplsaan als csv heeft toch hetzelfde effekt ?

 

[edmoor]

Klopt, maar of dat mogelijk is hangt af van de rest van het document. Ook moet je dan de csv extensie aan Excel hangen als dat nu niet zo is. Uiteraard is dat dan weer afhankelijk van het doel van het document zonder functies.

 

[Manon22]

Super bedankt Edmoor!

Het werkt. Ik ben er heel blij mee.

Groeten Manon:thumb: