VBA code Werblad opslaan als

oceanrace · 27 apr 2010

Hallo,

Ik heb een goed werkende VBA code voor Werkmap opslaan als.
Kan dit ook voor een speciefiek werkblad in een werkmap?

Code:

Sub Opslaan()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveWorkbook.SaveAs Filename:=strFileName
    MsgBox "Gelukt! Opgeslagen als: " & strFileName
  End If
End Sub

Groet,
Bas

oceanrace · 27 apr 2010

ik heb zelf al geprobeerd om

ActiveWorkbook.SaveAs Filename:=strFileName

te veranderen in

ActiveWorksheet.SaveAs Filename:=strFileName

maar dat werkt niet goed.

oceanrace · 27 apr 2010

Ik ben er al uit, dit is de juiste code.

Code:

Sub Opslaan()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs FileName:=strFileName
    MsgBox "Gelukt!  Opgeslagen als: " & strFileName
  End If
End Sub

oceanrace · 27 apr 2010

Met bovenstaande code sla je dus het actieve werkblad op onder de naam die in Cel AJ2 staat maar je kunt deze ook nog wijzigen, de directory waar je wilt opslaan kun je ook wijzigen.

Groet,
Bas

tvkijker · 31 mei 2010

vba script opslaan

Hallo Bas,

Ik ben "tvkijker", maar eigenlijk gewoon Dirk. Het lijkt wel of je mijn vraag op het bulletin van gisteren hebt gezien. Het is een rechtstreeks antwoord daarop. Bedankt hievoor.
Groeten,
Dirk

oceanrace · 31 mei 2010

Hallo Dirk,
Ik heb dit al een tijdje geleden gepost, maar graag gedaan.
Het is een handig tooltje.
In dit geval staat in cel AJ2 een adres met plaatsnaam, dit wordt dan de bestandsnaam.
Succes ermee

Groet,
Bas

tvkijker · 1 jun 2010

Hallo Bas,

Het werkt.... ongeloofelijk en ik heb ook al een opslagknop gemaakt

Maar kan jij mij ook aangeven hoe ik verschillende padnamen kan automatiseren in dit script ? Dus bijvoorbeeld:

-werkorder aanmaken -knop
-werkorder klaar knop
-factuurmaken knop.

Dit zijn de stadia di een orderfornulier (wat ik nu maak) doorloop. Dat formulieer wordt eerst opgeslagen als werkorder (daarvoor had ik de opslagroutine nodig) en als het werk klaar is gaat hij in een pad, waar de administrateur(mijn vrouw) ze op kan pikken voor de factuur. Daarna slaat zij ze weer op in een pad factuur. Ik hoop dat het wat duidelijk is.

Groeten,
Dirk

oceanrace · 1 jun 2010

Hoi Dirk,

Ik vul altijd in meerdere cellen gegevens in (adres huisnr en plaats) en vervolgens voeg ik die als tekst samen in 1 cel (AJ2).
Dan krijg je bij die macro de bestandsnaam.

Groet,
Bas

tvkijker · 2 jun 2010

Hallo Bas,
Ik denk dat ik je begrijp, maar met mijn vraag doelde ik op wat anders. Ik zou de diverse worksheets graag opslaan in diverse paden(directories), dus in /opdracht,daarna in /werkorder, dan in / wo gereed en tenslotte in /factuur.
Mijn vraag slaat dus op jpuw opmerking "de directory waar je wilt opslaan kun je ook wijzigen". Waar en hoe moet dat gebeuren in de code ?

Groeten,
Dirk

oceanrace · 2 jun 2010

Hoi Dirk,
als je zoekt op "macro opslaan als" vind je meer info (zie ook onderstaande link)

http://http://www.helpmij.nl/forum/showthread.php/509449-Macro-opslaan-als?highlight=vba+opslaan+als

nonono · 3 jun 2010

N.a.v. “Ik ben er al uit” (post #3) denk ik, dat deze code nog een aanvulling nodig heeft.
Met de code uit #3 kun je slechts 1x opslaan. Wanneer je een volgende keer weer wilt opslaan, dan krijg je een Run-Time error.

Normaal gesproken krijg je de vraag of je dit bestand wilt vervangen. En deze optie mist.

Als je met een bestand bezig bent, dan wil je tussentijds op kunnen slaan i.g.v. calamiteiten. En dan is het een waardevolle toevoeging aan deze code.

Ik ben geen expert in deze, maar wellicht een uitdaging voor de experts?

Groet Nono

tvkijker · 3 jun 2010

Bedankt Nono,

Yes, wie pakt dit op. Want dit soort kleine stapjes in een code zijn ook zeer leerzaam (voor mij althans) hoe het werkt.

Groeten,
Dirk

nonono · 3 jun 2010

De volgende (gevonden!) code lost dit probleem op:

Code:

Private Sub CommandButton1_Click()
'
Dim file_name As Variant
' Get the file name.
    file_name = Application.GetSaveAsFilename( _
        FileFilter:="Excel Files,*.xls,All Files,*.*", _
        Title:="Save As File Name")
' See if the user canceled.
    If file_name = False Then Exit Sub
' Save the file with the new name.
    If LCase$(Right$(file_name, 4)) <> ".xls" Then
        file_name = file_name & ".xls"
    End If
  ActiveWorkbook.SaveAs Filename:=file_name
'
End Sub

oceanrace · 28 jun 2010

oceanrace zei:

Ik ben er al uit, dit is de juiste code.

Code:

Sub Opslaan()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs FileName:=strFileName
    MsgBox "Gelukt!  Opgeslagen als: " & strFileName
  End If
End Sub

Weet iemand hoe je aan deze code kunt toevoegen: alleen waarden opslaan (dus zonder macro's en formules)?

Groet.
Bas

Warme bakkertje · 29 jun 2010

Code:

Else
        ActiveSheet.Copy
        With ActiveWorkbook
        .Sheets("Blad1").UsedRange.Value = .Sheets("Blad1").UsedRange.Value
        .SaveAs Filename:=strFileName
        End With
    MsgBox "Gelukt!  Opgeslagen als: " & strFileName
    End If

Voor het verwijderen van een macromodule zie http://www.cpearson.com/excel/vbe.aspx

oceanrace · 29 jun 2010

Code:

Sub Opslaan()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt het formulier niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    .Sheets("blad1").UsedRange.Value = .Sheets("blad1").UsedRange.Value
    .SaveAs Filename:=strFileName
    End With
  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub

Het is gelukt, alleen is het werkblad beveiligd en moet ik deze er eerst afhalen.
Kan dat ook in deze code toegevoegd worden?

Alvast bedankt,
Bas

Warme bakkertje · 29 jun 2010

Code:

With ActiveWorkbook
    With .Sheets("blad1")
        .Unprotect
        .UsedRange.Value = .UsedRange.Value
        .Protect
    End With
    .SaveAs Filename:=strFileName
End With

oceanrace · 29 jun 2010

Het is gelukt!
Bedankt voor je snelle hulp.

oceanrace · 29 jun 2010

Ik ben nog aan het uitproberen hoe je ook de macro's eruit kunt halen:

Code:

Sub Opslaanzonderformules()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    With .Sheets("blad1")
        .Unprotect
        .UsedRange.Value = .UsedRange.Value
        .Protect
    End With
    .SaveAs Filename:=strFileName
End With
  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub

De volgende code zou macro's kunnen verwijderen maar hoe verwerk ik die in de bovenstaande code?

Code:

Sub DeleteAllVBACode()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        
        Set VBProj = ActiveWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    End Sub

Groet,
Bas

Warme bakkertje · 30 jun 2010

Code:

Sub Opslaanzonderformules()
  Dim strFileName As Variant, strPath As String
  Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & [AJ2], _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
        With .Sheets("blad1")
            .Unprotect
            .UsedRange.Value = .UsedRange.Value
            .Protect
        End With
     Set VBProj = .VBProject
     For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    .SaveAs Filename:=strFileName
End With
  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub

VBA code Werblad opslaan als

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Gebruiker

Meubilair

Wij waarderen jouw privacy