Makro - använda samma sökväg när PDF skapas - Excel 365 för företag

[Mikael63]

Har ett makro som idag ser ut så här:

Sub Mark2PDF()
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\temp\mark2pdf.pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
End Sub

Jag skapar alltså en PDF av markerat område och sparar filen med ett specifikt namn på en specifik plats.

Jag vill att filen ska sparas på samma plats som Excelboken makrot körs från. (Makrot ligger dock i 'Egna makron')

Filnamnet kan få vara fast men det kan vara bra om filnamnet kan ärva bokens namn.

Hur ska det se ut då?

 

[MH_]

ActiveWorkbook, thisWorkbook och Me betyder lite olika saker

MsgBox "boken du jobbar med finns i mappen: " & ActiveWorkbook.Path
MsgBox "makrot ligger i mappen: " & ThisWorkbook.Path

Vill du ha sökvägen till excelfilen som du kopierar området ifrån? Om den är sparad borde det här funka:

Sub test()
Dim sSökväg As String
sSökväg = ActiveWorkbook.Path
'lägga på filnamnet
sSökväg = sSökväg & "\" &ActiveWorkbook.Name
End Sub

Om du startar makrot från ett formulär tror jag att du kan använda 

ME.xxxx

också.  Men "ME." är ganska flummigt. Jag är nästan säker på att Monshi låste en tråd om det där på Eforum
 

[Mikael63]

Tack!

Fungerar bra.
Om min bok heter 60045.xlsx kommer PDF,en att heta 60045.xlsx.pdf vilket egentligen är okej, ja faktiskt bättre på sitt sätt, men om man vill utesluta så att det bara blir 60045.pdf - hur ska koden se ut då?

[MH_]

Det enklaste är väl bara att ta bort 5 tecken på slutet. Om du är osäker (om det t.ex finns filer i gamla . xls format) så kan du istället hitta den sista punkten (med InStrRev)och ta bort allt till höger om den.

Sub qwwerty()
Dim sSökväg As String
Dim sFilnamn As String

sSökväg = ActiveWorkbook.Path
sSökväg = sSökväg & "\"

sFilnamn = ActiveWorkbook.Name
sFilnamn = Left(sFilnamn, InStrRev(sFilnamn, ".") - 1)

sSökväg = sSökväg & sFilnamn & ".pdf"
End Sub
 

Där jag antar att den sista .PDF kan tas bort

[Mikael63]

23 minuter sedan, MH_ sade:

Där jag antar att den sista .PDF kan tas bort

Nejdå, det gick bra med detta.

Stort tack!

[Mikael63]

Oj oj vilken nytta jag har haft av detta! Åter igen tack!
(varför kommer man på sånt här bra så sent?)

Skulle man våga sig på en liten modifiering? Jag (tror att jag) vill kunna få en varning om filen redan finns.

[MH_]

Du kan använda DIR (funkar som gamla doskommandot). Om du tar med filnamnet i din "Dir" så kan du se om du får ett svar eller inte

If Not Dir(sSökväg & sFilnamn) = "" Then
     MsgBox "Filen finns redan "
End If

Eller, med en val-box där du kan välj att avbryta

InputBox function (Visual Basic for Applications) | Microsoft Learn
VBA - Dialog Box - Automate Excel

T.ex så här (avbryter om du säger nej. Annars fortsätter makrot)

Dim svar As Integer
If Not Dir(sSökväg & sFilnamn) = "" Then
    svar = MsgBox("Filen finns redan. Vill du skriva över?", vbYesNo)
        If svar = vbNo Then
            Exit Sub
        End If
End If

 

Eller så här om du vill ge chansen att byta filnamn istället

If Not Dir(sSökväg & sFilnamn) = "" Then
    svar = MsgBox("Filen finns redan. Vill du ändra namn?", vbYesNo)
        If svar = vbYes Then
            sFilnamn = InputBox("Ange nytt namn", , sFilnamn)
        End If
End If

Ja. Du måste naturligtvis fixa det som skall göras före/efter. Men du fattar principen.

 

[Mikael63]

Tack!

Min kod ser nu ut så här:

Sub Mark2PDF()
'
' Mark2PDF Makro
' Skapar PDF av markerat område
'

'
   Dim sSökväg As String
Dim sFilnamn As String

sSökväg = ActiveWorkbook.Path
sSökväg = sSökväg & "\"

sFilnamn = ActiveWorkbook.Name
sFilnamn = Left(sFilnamn, InStrRev(sFilnamn, ".") - 1)

sSökväg = sSökväg & sFilnamn & ".pdf"

Dim svar As Integer
If Not Dir(sSökväg) = "" Then
    svar = MsgBox("Filen finns redan. Vill du skriva över?", vbYesNo)
        If svar = vbNo Then
            Exit Sub
        End If
End If

    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        sSökväg _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
       

End Sub

Jag plockade bort & sFilnamn eftersom jag la in snutten där sSökväg blivit både sökväg och filnamn.

(När jag testade med snutten att byta namn vet jag inte var filen hamnade)

[MH_]

Du kan ju hålla isär filnamn och sökväg tills du är färdig med kontrollen. Typ:

...början på makrot...
sFilnamn = ActiveWorkbook.Name
sFilnamn = Left(sFilnamn, InStrRev(sFilnamn, "."))
sFilnamn = sFilnamn & "pdf"

If Not Dir(sSökväg & sFilnamn) = "" Then
    svar = MsgBox("Filen finns redan. Vill du ändra namn?", vbYesNo)
        If svar = vbYes Then
            sFilnamn = InputBox("Ange nytt namn", , sFilnamn)
        End If
End If

' Sen slår du ihop den oförändrade sökvägen med det (eventuellt) ändrade filnamnet så att du bara får en sträng i ditt fortsatta makro:
sSökväg = sSökväg & sFilnamn

....Resten av ditt makro....

[Mikael63]

Tack igen!

Då blev det:

 

Sub Mark2PDF()
'
' Mark2PDF Makro
' Skapar PDF av markerat område
'

'
Dim sSökväg As String
Dim sFilnamn As String

sSökväg = ActiveWorkbook.Path
sSökväg = sSökväg & "\"
sFilnamn = ActiveWorkbook.Name
sFilnamn = Left(sFilnamn, InStrRev(sFilnamn, "."))
sFilnamn = sFilnamn & "pdf"

If Not Dir(sSökväg & sFilnamn) = "" Then
    svar = MsgBox("Filen finns redan. Vill du ändra namn?", vbYesNo)
        If svar = vbYes Then
            sFilnamn = InputBox("Ange nytt namn", , sFilnamn)
        End If
End If

sSökväg = sSökväg & sFilnamn

    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        sSökväg _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
       
End Sub

 

Edited February 13, 2023 by Mikael63