bestand opslaan als en opslaan als cel

[Tegno]

Wat zoek ik.
Ik heb een Calculatie bestand met macros.
Hier wil ik een Knop in zetten die het volgende doet.

1) Bestand opslaan in een Directoy met de tekst uit een cel. bv V:\calculaties\ "naam vanuit de cel"\
2) Als de directory nog niet bestaat moet hij ook de directory aanmaken (met een ingebouwde controle)
3) Bestand met de naam uit een andere cel.
4) als hij dit goed gedaan heeft zou ik daar een melding van willen krijgen.
5) dan wil ik verder met het calculatie bestand gaan voor de volgende caculatie

zover kom ik zelf

Private Sub Opslaan()Dim Path As String
Dim filename As String
Path = "V:\calculaties\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename & ".xlsm", FileFormat:=xlNormal
End Sub

 

[HSV]

Code is tevens voor meerdere mappen.

Sub hsv() CreateObject("shell.application").Namespace("V:").NewFolder Range("a1")
 ThisWorkbook.SaveCopyAs "V:\" & Range("a1") & Range("c1") & ".xlsb"
 msgbox "verwerkt"
End Sub

Met in cel A1 bv.

Calculaties\map1\map2\

en in cel C1

Tegno

 

[Tegno]

Code is tevens voor meerdere mappen.

Sub hsv() CreateObject("shell.application").Namespace("V:").NewFolder Range("a1")
 ThisWorkbook.SaveCopyAs "V:\" & Range("a1") & Range("c1") & ".xlsb"
 msgbox "verwerkt"
End Sub

Met in cel A1 bv.

Calculaties\map1\map2\

en in cel C1

Tegno

Bekijk bijlage 367169

Het werkt bijna goed. Hier Dank voor.
Het bestand slaat hij niet op in de directory welke hij aanmaakt kan je hier misschen nog naar kijken.

 

[Tegno]

Hij werkt perfect met dank aan HSV
Dit is het uiteindelijk geworden.

in A2 staat directory (gebazeerd op offerte nummer)
in Q2 word de bestandsnaam gegenereerd door tekst.samenvoegen
in R2 word de export directory gegenereerd door =tekst.samenvoegen("v\offertes";A2")

Sub save()
'Opslaan in mapstructuur
CreateObject("shell.application").Namespace("V:\MKG-OFFERTES\").NewFolder Range("A2")
 ThisWorkbook.SaveCopyAs Range("R2") & Range("Q2") & ".xlsm"
MsgBox "bestand opgeslagent"
Sheets("Calculatie").Select
Range("B2").Select
ActiveCell.Value = ActiveCell.Value + 10
Range("M2").Select
End Sub

Nogmaals bedankt voor de hulp!!

 

[HSV]

Het laatste stukje zonder te selecteren

Sheets("Calculatie").Select
Range("B2").Select
ActiveCell.Value = ActiveCell.Value + 10
Range("M2").Select

with Sheets("Calculatie").Range("B2")
 .Value = .Value + 10
 application.goto .parent.Range("M2"),true
end with

Wil je niet naar cel M2 scrollen (linkerbovenhoek), verwijder dan de komma en true (,true)

 

[snb]

Een melding dat iets is gelukt is overbodig als je goed programmeert.
Als je de code van HSV gebruikt al helemaal.