VBA - Opslaan als

Status
Niet open voor verdere reacties.
B

Buff85

Gebruiker
Lid geworden
10 mei 2023
Berichten
14
Goedemorgen,

Ik heb een vraag betreft het "opslaan als" met behulp van VBA. (Dit is voor mij de eerste keer dat ik met VBA werk).
Wij gebruiken regelmatig een sheet op het werk voor het calculeren. Dit bestand staat staat als een sjabloon op de server en word door meerdere mensen gebruikt. Nu is het de bedoeling dat wanneer het bestand opgeslagen wordt (Opslaan als), de naam automatisch aan het bestand gekoppeld gaat worden. De naam moet bestaan uit een projectnummer (blad4, cel D8) en een revisienummer (blad4, cel J8).
Ik heb tot nu toe de het volgende:

Code: 
[I]Sub OpslaanBestandsnaam()
Pad = ActiveWorkbook.Path & ""
If Worksheets(4).Range("D8") <> "" And Worksheets(4).Range("J8") <> "" Then

Naam = "Calculatie" & " " & Worksheets(4).Range("D8") & " " & "Rev." & Worksheets(4).Range("J8")
ActiveWorkbook.SaveAs ".xlsm"

Else
MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
End If
End Sub[/I]


Nu geeft dit altijd de waarde voor "Else" als ik het script uitvoer. Kunnen jullie mij vertellen waar dit fout gaat?
Alvast bedankt!
 

Bijlagen

Laatst bewerkt:
Een document kan altijd van privacy gevoelige informatie worden ontdaan.

Dat de Else wordt uitgevoerd zegt dus dat in Worksheets(4) de cellen D8 en J8 leeg zijn.
Daarnaast is dit uiteraard fout:
Code: 
ActiveWorkbook.SaveAs ".xlsm"
Tevens gebruik je de variabele Pad nergens.
 
Laatst bewerkt:
Zonder voorbeeld beetje moeilijk te testen maar probeer dit eens:

Code: 
Sub OpslaanBestandsnaam()
Pad = ActiveWorkbook.Path & ""
If Worksheets(4).Range("D8") <> "" And Worksheets(4).Range("J8") <> "" Then

Naam =
ActiveWorkbook.SaveAs ThisWorkbook.Path &  "\Calculatie" & " " & Worksheets(4).Range("D8") & " " & "Rev." & Worksheets(4).Range("J8")" & ".xlsm"

Else
MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
End If
End Sub
 
edmoor zei:
Een document kan altijd van privacy gevoelige informatie worden ontdaan.

Dat de Else wordt uitgevoerd zegt dus dat in Worksheets(4) de cellen D8 en J8 leeg zijn.
Daarnaast is dit uiteraard fout:
Code: 
ActiveWorkbook.SaveAs ".xlsm"
Tevens gebruik je de variabele Pad nergens.
Klik om te vergroten...

Goedemorgen,

Bedankt voor de reactie.
Ik heb uiteraard eerst getest met het invullen van de cellen. Alle cellen leeg laten, 1 van beide cellen invullen en beide cellen wel invullen, geeft hetzelfde resultaat. Namelijk de pop-up met de foutmelding.

Zoals aangegeven werk ik voor het eerst met VBA. Kan je mij vertellen wat er fout is een het SaveAs deel en hoe ik dat juist kan krijgen?
En ik weet ook niet wat de variabele Pad is. Wellicht dat je mij een voorbeeld kan geven?

Mvg,

Eric
 
mvdvlist zei:
Zonder voorbeeld beetje moeilijk te testen maar probeer dit eens:

Code: 
Sub OpslaanBestandsnaam()
Pad = ActiveWorkbook.Path & ""
If Worksheets(4).Range("D8") <> "" And Worksheets(4).Range("J8") <> "" Then

Naam =
ActiveWorkbook.SaveAs ThisWorkbook.Path &  "\Calculatie" & " " & Worksheets(4).Range("D8") & " " & "Rev." & Worksheets(4).Range("J8")" & ".xlsm"

Else
MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
End If
End Sub
Klik om te vergroten...

Goedemorgen,

Hartelijk dank voor de reactie! Helaas geeft dit een foutmelding, namelijk:

Compileerfout:
Syntaxisfout

Mvg,

Eric
 
Laatst bewerkt:
Weet je zeker dat Worksheets(4) het werkblad met de naam Blad4 is?
Probeer het zo maar eens:
Code: 
Sub OpslaanBestandsnaam()
    With Worksheets(4)
        If .Range("D8") <> "" And .Range("J8") <> "" Then
            ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\Calculatie " & .Range("D8") & " " & "Rev." & .Range("J8") & ".xlsm"
        Else
            MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
        End If
    End With
End Sub
 
Laatst bewerkt:
edmoor zei:
Weet je zeker dat Worksheets(4) het werkblad met de naam Blad4 is?
Probeer het zo maar eens:
Code: 
Sub OpslaanBestandsnaam()
    With Worksheets(4)
        If .Range("D8") <> "" And .Range("J8") <> "" Then
            ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\Calculatie " & .Range("D8") & " " & "Rev." & .Range("J8") & ".xlsm"
        Else
            MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
        End If
    End With
End Sub
Klik om te vergroten...

Bedankt voor de reactie, maar ook dit geeft de "Else" voorwaarde, ook al zijn cellen D8 en J8 ingevuld. Ik zal de naam van de sheet nog eens controleren.
Wellicht dat ik ook een document aan kan maken dat ter voorbeeld kan dienen.
 
Of gebruik dit:
Code: 
With Worksheets("Blad4")
 
Er is dus geen Blad4 en ook geen blad met index 4.
Dus op welk blad moet er naar D8 en J8 worden gekeken?
Overigens zijn die cellen in geen enkel werkblad gevuld.

Daarnaast is het een .xls bestand en die kan je niet zomaar op die manier als .xlsm opslaan.
 
Laatst bewerkt:
edmoor zei:
Er is dus geen Blad4 en ook geen blad met index 4.
Dus op welk blad moet er naar D8 en J8 worden gekeken?
Klik om te vergroten...

Dat kom omdat ik het bestand leeg gehaald heb. In dit voorbeeldbestand is het "Blad1" geworden.
 
Dan maak je er With Worksheets("Calc overz") van.

Maar is je originele document een .xls?
 
Niet als het origineel een .xls is.
Dan moet het dit zijn:
Code: 
Sub OpslaanBestandsnaam()
    With Worksheets("Calc overz")
        If .Range("D8") <> "" And .Range("J8") <> "" Then
            ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\Calculatie " & .Range("D8") & " " & "Rev." & .Range("J8") & ".xlsm", 52
        Else
            MsgBox "Voer project en revisienummer in!", vbCritical, "Bestandsnaam onjuist"
        End If
    End With
End Sub
En dan moet je ook werken met Office 2007 of hoger.
Of geen .xlsm maar .xls opslaan, dan kan die ,52 weer weg.
 
Laatst bewerkt:
edmoor zei:
Dan maak je er With Worksheets("Calc overz") van.

Maar is je originele document een .xls?
Klik om te vergroten...

Top, dat lijkt te werken!

Is het verder ook nog mogelijk om de opslaglocatie te bepalen als zijnde:

Path = "C:\locatie\”Projectnummer uit cel D8”\

Zoals gezegd is VBA helemaal nieuw voor mij.
 
Dat kan zo:
Code: 
ActiveWorkbook.SaveAs "C:\locatie\" & .Range("D8") & " " & "Rev." & .Range("J8") & ".xlsm"
 
Laatst bewerkt:
@buff: de QUOTE knop is geen antwoord knop. Gebruik de daarvoor bedoelde knop (<Reageer op bericht>) of, nog handiger, typ je antwoord in het niet te missen tekstvak <Snel reageren>. Daar maak je een hoop mensen blij mee.
 
Goedemorgen,

Ik heb de code zoals beschreven nu in gebruik in de calculatiesheet. Er is alleen nog een klein probleem wat ik zou moeten oplossen.
Wanneer ik de opgeslagen sheet nu open vanaf de locatie krijg ik de melding "De bestandsindeling en -extentsie van <<Documentnaam>> komen niet overeen." Het bestand moet zoals aangegeven een .xls bestand zijn, maar hij slaat toch op als een .xlsx bestand. Ik vermoed dat de fout ontstaat op het moment dat ik het bestand omzet van de master versie, naar het sjabloon die beschikbaar gesteld is voor iedereen op de server.
Wat zou ik hier aan kunnen doen?

Code: 
Sub OpslaanBestandsnaam()
    With Worksheets("Calc overz")
        If .Range("D8") <> "" And .Range("J8") <> "" Then

Dim Path1 As String
Dim Path2 As String
Dim Path3 As String
Dim Filename As String
Dim fpathname As String

Path1 = "\\APPMOHVIE01\Projecten\"
Path2 = Range("D8")
Path3 = "\02 Calculatie\"
Filename = "Calculatie" & " " & .Range("D8") & " " & "Rev." & .Range("J8") & ".xls"
fpathname = Path1 & "\" & Path2 & "\" & Path3 & "\" & Filename
            ActiveWorkbook.SaveAs Filename:=fpathname

        Else
            MsgBox "Project en revisienummer dienen ingevuld te zijn.", vbCritical, "Niet alle gegevens zijn ingevuld!"
        End If
    End With
End Sub
 
Waarom sla je het bestand op als .xls en niet als .xlsm?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan