• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Opslaan als - VBA

Status
Niet open voor verdere reacties.
M

MatthiasPBelmans

Gebruiker
Lid geworden
13 aug 2020
Berichten
50
Hoi

Ik ben in mijn excel file een aantal knoppen aan het zetten die de actie zou moeten versnellen.
Nu probeer ik een VBA knop met Save as te maken, maar dit wilt niet lukken

PHP: 
Sub SaveAsDialog()

With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Please choose or create a folder to save file"
    .ButtonName = "Save EXP"
    .InitialFileName = "I:\mapnaam\folder\folder\EXPORT\" & Range("D34").Value
    .Show
End With

End Sub

Ik krijg de prompt opdracht wel, maar hij slaagt de file niet op
momenteel is de extensie .XLSM maar zou .XLSX moeten worden

Grtz
 
Laatst bewerkt:
hoi

ik heb de code van Ron de Bruin gebruikt
maar nu wordt er enkel 1 sheet opgeslagen
Ik zou graag willen dat er van heel het werkboek gesaved word als
PHP: 
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub
 
hoi

ik heb de code van Ron de Bruin gebruikt
maar nu wordt er enkel 1 sheet opgeslagen
Ik zou graag willen dat er van heel het werkboek gesaved word als
PHP: 
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub
 
de naam zegt het al:Sub Copy_ActiveSheet_2()

google eens op: ActiveWorkbook.SaveAs
 
de naam zegt het al:Sub Copy_ActiveSheet_2()

google eens op: ActiveWorkbook.SaveAs
 
Zo lukt het ook.
Code: 
Sub Save_As_XLSX()
    'Thanks to AlphaFrog
    ActiveWorkbook.Sheets.Copy
    ActiveWorkbook.SaveAs Filename:="C:\Folder Naam Hier\Junk.xlsx", FileFormat:=51    '<---- Change as required
    ActiveWorkbook.Close
End Sub
 
oke, ik heb nu mijn excelfile kunnen opslaan met de VBA.
Echter zou ik nu nog graag dat de filenaam uit een cel komt, maar ik geraak er echt niet uit hoe ik dit moet klaarspelen...
 
bestandsnaam in cel A1.
Code: 
"C:\Folder Naam Hier\" & Range("A1").Value & ".xlsx"

Er zijn trouwens veel voorbeelden te vinden op HelpMij
 
Code: 
Sub Save_As_XLSX()
    'Thanks to AlphaFrog
    ActiveWorkbook.Sheets.Copy
    ActiveWorkbook.SaveAs Filename:="C:\Folder Naam Hier\[COLOR="#FF0000"]range("a1")[/COLOR].xlsx", FileFormat:=51    '<---- Change as required
    ActiveWorkbook.Close
End Sub
 
Die laatste zal niet werken.

Code: 
sub maakkopie()
thisworkbook.savecopyas [COLOR=#CC0000]"I:\mapnaam\folder\folder\EXPORT\" & Range("[/COLOR][COLOR=#3E3E3E]D34[/COLOR][COLOR=#CC0000]").Value[/COLOR] & ".xlsx"
end sub

Overigens is D34 wel van het actieve werkblad.
Als de code onder een knop zit is het geen probleem, anders je bladnaam vermelden in de code.

Code: 
"I:\mapnaam\folder\folder\EXPORT\" & [COLOR=#ff0000]sheets("bladnaamhier").[/COLOR]Range("D34").Value & ".xlsx"
 
Sorry, mijn fout, ik heb toch deze code gebruikt...
Aanpassing gedaan zodat die de workbook opslaagt ipv de activesheet.
Echter hier kan ik niet definieren waar ik de verwijzing naar de bepaalde cel
PHP: 
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long
 
    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then
 
        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")
 
        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook
 
            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing
 
        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
 
        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select
 
            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook
 
                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing
 
            End If
        End If
    End If
End Sub
 
#11, meer heb je niet nodig.
 
@HSV hoe bedoel je.?

Ik zou moeten verwijzen voor het bestandsnaam naar cel D34 van een bepaalde sheet, maar waar in de code moet deze staan?
Ik ben helemaal niet vertrouwd met VBA

Grtz
 
De code gegeven op 18:22 uur.
Daar staat het voor je klaar.
 
@HSV, als ik deze zo doe zoals in de comment van 18:22, krijg ik een error
PHP: 
Sub SaveWorkBook()
'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long
 
    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then
 
        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the file to a new workbook")
 
        If fname <> False Then
            'Copy the ActiveWorkbook to new workbook
            ActiveWorkbook.SaveCopyAs "I:\mapnaam\folder\folder\EXPORT\" & Sheets("DATA INPUT").Range("D34").Value & ".xlsx"
            Set NewWb = ActiveWorkbook
 
            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing
 
        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the file to a new workbook")
 
        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select
 
            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                'ActiveWorkbook.SaveCopyAs
                Set NewWb = ActiveWorkbook
 
                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing
 
            End If
        End If
    End If
End Sub
 
Gooi die code weg die jij steeds presenteert.
Zie post 11.
 
ik kan deze niet opslaan op een bepaalde map, er wordt per dossier een nieuwe map aangemaakt op de server.
Dus ik zou het pop-up venster moeten hebben...
PHP: 
Sub maakkopie()
ThisWorkbook.SaveCopyAs "Sheets("DATA INPUT").Range("D34").Value & ".xlsx"
End Sub
deze werkt dus niet goed
 
Het adres van de server moet er nog voor.
Thisworkbook.savecopyas "naam van server" en dan de rest.
 
HSV, ik zou de map moeten kunnen kiezen, deze veranderd per dossier...
Het origineel staat op onze sharepoint we gebruiken deze, de insteek is dat als we op de knop OPSLAAN klikken
dat het venster SaveAs opstart, we de juiste map kiezen en deze opslaagt met de bestandsnaam die in cel D34 staat.

Als ik de code gebruik in #11 slaagt excel het document gewoon op de server zonder een keuze aan te biede welke map ik wil
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan