Excel Macro voor opslaan werkmap

[Henk B]

Wie kan mij helpen aan een Excel Macro voor het opslaan van een Excel werkmap in de huidige directory waar deze op dat moment staat.

Het kan voorkomen dat de werkmap in een andere directory staat dan moet het in de directory worden opgeslagen waar dit bestand op dat moment staat.

 

Het bestand, werkmap, moet worden opgeslagen met de bestandsnaam opgebouwd met gegevens uit cel A1 en A2 en met huidige datum en tijd..

 

Ik had wat gevonden maar dit zet het in de directory Documenten, dat is niet wat ik zoek.

 

Alvast bedankt

 

[Haije]

Hoi Henk, wil je eens laten zien wat je gevonden hebt? Wellicht is dat eenvoudig aan te passen....

 

TIP: plaats een bestand met wat je gevonden hebt als bijlage....

[Henk B]

Hallo Haije,

 

Bedankt voor je reactie.

Hieronder de macro waar ik het over had.

Deze macro plaats het bestand nu met SaveAs in de Documenten directory met wel een optie om naar de juiste directory te gaan en het dan op te slaan.

Ik zou graag direct in de directory willen opslaan.

De verdere opbouw van de macro is zoals ik deze zou willen gebruiken.

Het is een programma voor het registreren van toernooi gegevens en wanneer er nieuwe gegevens zijn ingevoerd dit in een nieuw bestand wordt opgeslagen

De gegevens uit K7 en K8 zijn de toernooi naam en jaar, sorry ik had A1 en A2 doorgegeven en dat is niet juist.

Hopelijk heb je hier wat aan en kan je mij verder helpen.

Alvast bedankt

 

 Dim intVraag As Integer
    intVraag = MsgBox("Weet u zeker dat u het bestand wilt opslaan. " & Chr(13) & Chr(13) & "Uw gegevens worden als nieuw bestand opgeslagen, oude bestand blijft behouden ! " & Chr(13) & Chr(13) & "Wordt opgeslagen met met de ingevoerde TOERNOOINAAM en JAAR of PERIODE :" & Chr(13) & "TOERNOOINAAM JAAR of PERIODE opgeslagen op jjjj-mm-dd hh-mm " & Chr(13) & Chr(13) & "Selecteer indien nodig de map waar het bestand moet worden opgeslagen !", vbYesNo, " OPSLAAN NIEUWE BESTANDNAAM MET HUIDIGE DATUM / TIJD ")
    If intVraag = vbYes Then

Dim xWb As Workbook
Dim xStr As String
Dim xStrOldName As String
Dim xStrDate As String
Dim xFilename As String
Dim xFileDlg As FileDialog
Dim i As Variant

Application.DisplayAlerts = False
Set xWb = ActiveWorkbook
xStrOldName = xWb.Name

xStr = CStr(Range("K7").Value) & Chr(32) & Chr(32) & (Range("K8").Value) & Chr(32) & Chr(32) & "opgeslagen op" & Chr(32) & Chr(32) & Format(Now, "yyyy-mm-dd   hh-mm")

If Range("K7") <> "Geen gegevens ingevoerd" And Range("K8") <> " " Then

If Right(xStrOldName, 4) = "xlsm" Then
    xFilename = Application.GetSaveAsFilename(xStr, "Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
Else
 xFilename = Application.GetSaveAsFilename(xStr, "Excel Workbook (*.xlsx),*.xlsx")
End If

Else
    MsgBox "De naam van het bestand is nog niet compleet" & Chr(13) & Chr(13) & "De toernooi gegevens zijn nog niet compleet ingevoerd" & Chr(13) & Chr(13) & "Ga naar TOERNOOI GEGEVENS en voer de ontbrekende gegevens in !", vbCritical
Exit Sub
End If

'If Right(xStrOldName, 4) = "xlsm" Then
'    xFilename = Application.GetSaveAsFilename(xStr, "Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
'Else
' xFilename = Application.GetSaveAsFilename(xStr, "Excel Workbook (*.xlsx),*.xlsx")
'End If

  xWb.SaveAs (xFilename)

Application.DisplayAlerts = True

End If
End Sub

 

[Haije]

Henk, zie de bijlage

voor HenkB.xlsm

[Henk B]

Haije

 

Bedankt voor de reactie en de macro.

Als ik op de knop druk komt als eerste de Documenten directory waar het bestand naartoe wordt opgeslagen.

Ik had de hoop dat de directory waar het bestand op dat moment in staat als eerste zou komen.

Dus in welke directory het bestand op dat ook moment staat het opslaan van het bestand ook in deze directory plaats vindt.

Op jouw voorbeeld plaatje lijkt het erop dat jouw het wel is gelukt.

Is dat mogelijk naar je weet of niet.

 

[Haije]

Henk,

 

maak van

xStr = CStr(Range("K7").Value) & Chr(32) & Chr(32) & (Range("K8").Value) & Chr(32) & Chr(32) & "opgeslagen op" & Chr(32) & Chr(32) & Format(Now, "yyyy-mm-dd   hh-mm")

eens

xStr = ActiveWorkbook.Path & "\" & CStr(Range("K7").Value) & Chr(32) & Chr(32) & (Range("K8").Value) & Chr(32) & Chr(32) & "opgeslagen op" & Chr(32) & Chr(32) & Format(Now, "yyyy-mm-dd   hh-mm")

[alpha]

@Henk,

als je dat dialoogvenster niet wil, dan moet je het ook niet oproepen!

Het uitschakelen van meldingen kun je best achterwege laten,  als je dat niet doet heb je geen enkel zicht op wat er fout gaat. Het bestand kan dan in de huidige vorm bv. ook opgeslagen worden als niet alle gegevens zijn ingevuld.

Quote

een Excel Macro voor het opslaan van een Excel werkmap in de huidige directory waar deze op dat moment staat.

Het kan voorkomen dat de werkmap in een andere directory staat dan moet het in de directory worden opgeslagen waar dit bestand op dat moment staat.

Dat is een contradictio in terminis: de huidige directory is altijd de directory van het bestand waarmee je aan het werken bent!

Ik heb geen zicht op WAAR in je bestand WAT staat, maar probeer dit eens:

Sub macro1()
Dim vr As Integer, newname As String
vr = MsgBox("Weet u zeker dat u het bestand wilt opslaan?", 4)
If vr = vbNo Then Exit Sub
If WorksheetFunction.Or(IsEmpty(Range("K7")), IsEmpty(Range("K8"))) Then
MsgBox "De naam van het bestand is nog niet compleet want" & Chr(13) & Chr(13) & _
"de toernooigegevens zijn nog niet volledig ingevuld." & Chr(13) & Chr(13) & _
"Ga naar TOERNOOIGEGEVENS en voer de ontbrekende gegevens in !", 48
Exit Sub
End If
newname = Range("k7").Value & " " & Range("K8").Value & " " & Format(Now, "dd-mm-yy hh-mm-ss") & ".xlsm"
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & newname
MsgBox ("Het bestand werd opgeslagen als" & Chr(13) & Chr(13) & """" & newname & """" & Chr(13) & Chr(13) & _
"Het oude bestand werd behouden.")
End Sub

19 februari 2019 aangepast door alpha

[Henk B]

Haije

 

Sorry voor mijn late reactie.

 

Ik heb de regel  aangepast en het lijkt erop dat nu inderdaad eerst de directory wordt gekozen waar het bestand al in staat.

Je hebt nog steeds de keuze om het op te slaan waar je het bestand eventueel toch zou willen hebben.

Het lijkt erop dat je mijn probleem hebt opgelost.

Super en hartelijk dank

 

Met vriendelijke groet Henk

 

 

 

[kweezie wabbit]

Op 19/2/2019 om 10:29, Henk B zei:

Het lijkt erop dat je mijn probleem hebt opgelost.

Dan kunnen we de vraag afsluiten.

Succes nog.