Jump to content

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


Go to solution Solved by MH_,

Recommended Posts

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å?

 

Link to comment
Share on other sites

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
 

  • Thanks 1
Link to comment
Share on other sites

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

  • Thanks 1
Link to comment
Share on other sites

  • 3 weeks later...

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.

 

  • Thanks 1
Link to comment
Share on other sites

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)

Link to comment
Share on other sites

  • Solution
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....

  • Thanks 1
Link to comment
Share on other sites

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 by Mikael63
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...