Opgelost celwaarde als bestandsnaam toepassen

[Cartucci]

Besten,

Onderstaand script wil ik gebruiken om 2 waarden in cel E1 en H1 te gebruiken als bestandsnaam. Als ik onderstaand script toepas, wordt elk bestand echter "Blad1!e1Blad1!h1".xlsm gedoopt. De celwaarden worden niet overgenomen. De macro wordt gestart via een knop in de spreadsheet.

Het is vast iets simpels maar kan iemand mij vertellen wat ik niet goed doe?

Sub Opslaan()
Pad = ActiveWorkbook.Path & ""
If Range("Blad1!e1") <> "" And Range("Blad1!h1") <> "" Then
Naam = "Blad1!e1" & "Blad1!h1"
ActiveWorkbook.SaveAs Pad & Naam
Else
MsgBox "A.u.b. ordernummers ingeven in E1 en H1!", vbCritical
End If
End Sub

En, is het mogelijk dit script te voorzien van een code waarbij het bestand automatisch opgeslagen wordt met de bestandsnaam uit E1 en H1 als iemand het bestand afsluit waarbij hij/zij verzuimt op de knop " Opslaan" te klikken?

 

[Haije]

zo beter?

Sub Opslaan()
Pad = ActiveWorkbook.Path & ""
If Range("Blad1!e1") <> "" And Range("Blad1!h1") <> "" Then
[COLOR="#FF0000"]Naam = Range("Blad1!e1") & Range("Blad1!h1")[/COLOR]
ActiveWorkbook.SaveAs Pad & Naam
Else
MsgBox "A.u.b. ordernummers ingeven in E1 en H1!", vbCritical
End If
End Sub

 

[OctaFish]

Dat is logisch, dat je naam niet klopt. Je definieert hem hard als tekst, niet als verwijzing. Wat je daarboven dan gek genoeg wél goed doet .

        Naam = Range("Inkomsten!e1") & Range("Inkomsten!g2")

 

[edmoor]

@Haije:
Er is een \ weg gevallen.

 

[Cartucci]

allereerst bedankt voor de snelle hulp!

Maar, het werkt nog niet. Ik krijg een foutmelding "400"

Het script heb ik als onderstaand ingevoerd:

Sub Opslaan()
Pad = ActiveWorkbook.Path & ""
If Range("Blad1!e1") <> "" And Range("Blad1!h1") <> "" Then
Naam = Range("Blad1!e1") & Range("Blad1!h1")
ActiveWorkbook.SaveAs Pad & Naam
Else
MsgBox "A.u.b. ordernummers ingeven in E1 en H1!", vbCritical
End If
End Sub

Het \ teken staat tussen de aanhalingstekens in regel 2 maar op een of andere manier wordt dat verwijderd als ik het script knip en plak in dit bericht

 

[edmoor]

Plaats je code in codetags en tevens een voorbeeld document.
Ook in de code die je in #5 plaatste is een \ weg gevallen.

 

[OctaFish]

Verbaast me niks dat hij het niet doet, omdat je nog steeds geen backslash gebruikt.

Sub Opslaan()
    Pad = ActiveWorkbook.Path & "\"
    If Range("Blad1!e1") <> "" And Range("Blad1!g2") <> "" Then
        Naam = Range("Blad1!e1") & Range("Blad1!g2")
        ActiveWorkbook.SaveAs Pad & Naam
    Else
        MsgBox "A.u.b. ordernummers ingeven in E1 en H1!", vbCritical
    End If
End Sub

 

[Cartucci]

Het werkt hoor. Hartelijk dank voor de tips. Dat wegvallen van de backslash is een vreemde. Bij knippen uit excel en plakken in een bericht, wordt hij niet mee gekopieerd.

Mijn 2e vraag staat nog wel open:

Is het eenvoudig om een VB script toe te voegen aan het script zodat bij regulier afsluiten van het bestand, het automatisch opgeslagen wordt met de celwaarden in de naam?

Zie bijgaand ook het voorbeeld bestand.

 

[Haije]

Het werkt hoor. Hartelijk dank voor de tips. Dat wegvallen van de backslash is een vreemde. Bij knippen uit excel en plakken in een bericht, wordt hij niet mee gekopieerd.

Oorzaak: het niet gebruiken van de codetags.

Als je in ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Opslaan
End Sub

zet en de macro Opslaan in module1

Werkt dat dan zoals je wenst?

 

[Cartucci]

Die opmerking over de codetags kon niet niet goed plaatsen. Maar, ik begrijp hem nu denk ik.

[CODE]Sub Opslaan()
Pad = ActiveWorkbook.Path & "\"
If Range("Blad1!f1") <> "" And Range("Blad1!h1") <> "" Then
Naam = Range("Blad1!e2") & Range("Blad1!i1") & Range("Blad1!f1") & Range("Blad1!i1") & Range("Blad1!g2") & Range("Blad1!i1") & Range("Blad1!h1")
ActiveWorkbook.SaveAs Pad & Naam
Else
MsgBox "A.u.b. ordernummers ingeven in F1 en H1!", vbCritical
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Opslaan
End Sub

Dit script gebruik ik nu en het werkt, ook bij afsluiten via regulier afsluiten.

Maar, het bestand wordt 1 map terug opgeslagen dan waar het staat. Dus, als ik het pad W:/Map A/Map B heb, en het bestand staat in Map B, dan vind ik het na uitvoeren van de macro terug in Map A. Kan iemand me daar nog even op weg helpen? Ik doorzie niet waar daar opdracht voor gegeven wordt in het script.

 

[VenA]

Lijkt mij stug.

wat geeft

msgbox ActiveWorkbook.Path

 

[HSV]

Als het voor het bestand is waarin de code staat gebruik je

ThisWorkBook.Path & "\"

en geen

ActiveWorkBook.Path & "\"

Maak gebruik With en End With i.p.v. dat geknoei met:

Naam = Range("Blad1!e2") & Range("Blad1!i1") & Range("Blad1!f1") & Range("Blad1!i1") & Range("Blad1!g2") & Range("Blad1!i1") & Range("Blad1!h1")

 

[VenA]

Of, om het een beetje onleesbaar te maken, zet de gegevens in een array

Sub Opslaan()
  ar = Sheets("Blad1").Range("A1:I2")
  If ar(1, 6) <> "" And ar(1, 8) <> "" Then
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ar(2, 5) & ar(1, 9) & ar(1, 6) & ar(1, 9) & ar(2, 7) & ar(1, 9) & ar(1, 8)
   Else
    MsgBox "A.u.b. ordernummers ingeven in F1 en H1!", vbCritical
  End If
End Sub

 

[HSV]

Onzin die losse Sub, rechtstreeks in ThisWorkBook; klaar.

 

[Cartucci]

Er zijn meerdere manieren dus. Intussen heb ik met jullie hulp precies voor elkaar wat ik voor ogen had. Opslaan met celgegevens via een knop en opslaan met celgegevens bij regulier afsluiten. Het werkt prima zo. Dank aan allen voor het meedenken!