| Forfatter |
 Emne Søg  Emne funktioner
|
kbno 
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
 Emne: Opret folder efter cellenavn
Sendt: 03.Jul.2017 kl. 11:56 |
Hej Med Jer Jeg har følgende kode som jeg bruger til at oprette en folder på skrivebordet. Men nu vil jeg godt have lavet en underfolder med navnet som findes i en celle i fanen "Oprettelse". Jeg er klar over at det er i linien med "DataSti", men har desværre ikke fundet noget kode der virker. Håber der er en som kan hjælpe  Sub gemsom_PDF()
Dim ArkNavn, DataSti, Filnavn As String
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
ArkNavn = ActiveSheet.Name
DataSti = objFolders("Desktop") & "\Aftalesedler\"
Filnavn = Sheets(ArkNavn).[B4].Value & " " & Sheets(ArkNavn).[c4].Value & " - " & Sheets(ArkNavn).[H10].Value & " - " & Sheets(ArkNavn).[H4]
If Dir(DataSti, vbDirectory) = "" Then
MkDir DataSti
End If
Sheets(ArkNavn).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=DataSti & Filnavn, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=1, _
OpenAfterPublish:=False
MsgBox "Filen er gemt som: " & Filnavn & ".pdf" & " på skrivebordet", vbInformation
End Sub
|
|
Hygge - Kim
Excel 365 DK user
|
 |
|
|
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
 Accepteret svar
Sendt: 04.Jul.2017 kl. 15:23 |
OK, prøv med denne:
Sub GemSom_PDF()
Dim ArkNavn, DataSti, Filnavn As String
ArkNavn = ActiveSheet.Name
DataSti = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value & "\"
Filnavn = Sheets(ArkNavn).[B4].Value & " " & Sheets(ArkNavn).[D4].Value & " - " & Sheets(ArkNavn).[H4]
' Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den
MakeDIRs DataSti
' Indsætter versions nummer på udskrift
' ActiveSheet.PageSetup.RightFooter = Sheets("Forside").Range("G4").Value
' Gemmer det aktive ark som .PDF
Sheets(ArkNavn).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=DataSti & Filnavn, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=1, _
OpenAfterPublish:=False
' Besked boks om filenavn '& DataSti'
MsgBox "Filen er gemt som: " & Filnavn & ".pdf" & " på skrivebordet", vbInformation
End Sub |
Den virker hos mig
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
Sendt: 03.Jul.2017 kl. 12:30 |
|
Hej Kim,
MkDir funktionen har desværre en række begrænsninger - bl.a. kan funktionen ikke lave en komplet sti i 'et hug', men skal oprette, hvert eneste trin i stien for sig selv.
Må jeg anbefale, at du benytter 'MakeDIRs' API'en i stedet - den er langt mere robust, og 100% kompatibel med Windows /da det jo et Window' egen API, der benyttes).
www.excelgaard.dk/Bib/API/MakeDIRs/ www.excelgaard.dk/Bib/API/MakeDIRs/
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 03.Jul.2017 kl. 13:07 |
|
Hej Excelgaard
Hvis jeg læser koden så kræver den en konstant sti. Mit behov er at jeg skal oprette underfolderen ud fra en tekst i celle G5 fra fanen "oprettelse"
|
|
Hygge - Kim
Excel 365 DK user
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
Sendt: 03.Jul.2017 kl. 14:42 |
Arj, kom nu, Kim Du kan vel finde ud af, at lave en konstant om til en variabel???
Dim Path_To_Make As String
Path_To_Make = Sheets("Oprettelse").Range("G5").Value
' Or...
Path_To_Make = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value |
Eller er det mig, der helt misforstår opgaven???
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 04.Jul.2017 kl. 08:48 |
Hej Excelgaard Jeg er en novice i VBA og roder yderst sjældent med det. Så jeg skal starte fra nul hver gang  Jeg har sågar problemer med at få din kode lagt ind i mit script  Jeg tror såmænd ikke du har misforstået opgaven, det er nok bare mig der ikke magter løsningen  
|
|
Hygge - Kim
Excel 365 DK user
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
Sendt: 04.Jul.2017 kl. 09:20 |
Stadig prisværdigt, at du prøver  Der, hvor da har 'DataSti=', vil jeg mene, at du skal have
DataSti = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value |
...og, så skal du naturligvis huske, at ligge API funktionen i toppen af modulet, som vist i min link til API funktionen. Hvis du stadig ikke kan få det til, at virke, er du nok nødt til at uploade dit regneark...
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 04.Jul.2017 kl. 09:30 |
Jeg har sendt dig en PM 
|
|
Hygge - Kim
Excel 365 DK user
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
Accepteret svar
Sendt: 04.Jul.2017 kl. 15:23 |
OK, prøv med denne:
Sub GemSom_PDF()
Dim ArkNavn, DataSti, Filnavn As String
ArkNavn = ActiveSheet.Name
DataSti = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value & "\"
Filnavn = Sheets(ArkNavn).[B4].Value & " " & Sheets(ArkNavn).[D4].Value & " - " & Sheets(ArkNavn).[H4]
' Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den
MakeDIRs DataSti
' Indsætter versions nummer på udskrift
' ActiveSheet.PageSetup.RightFooter = Sheets("Forside").Range("G4").Value
' Gemmer det aktive ark som .PDF
Sheets(ArkNavn).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=DataSti & Filnavn, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=1, _
OpenAfterPublish:=False
' Besked boks om filenavn '& DataSti'
MsgBox "Filen er gemt som: " & Filnavn & ".pdf" & " på skrivebordet", vbInformation
End Sub |
Den virker hos mig
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 05.Jul.2017 kl. 12:22 |
Det er bare perfekt
|
|
Hygge - Kim
Excel 365 DK user
|
|
EXCELGAARD
Platin bruger
Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5417
|
Sendt: 05.Jul.2017 kl. 13:23 |
Velbekomme - husk, at acceptere svaret
|
|
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.
|
|
Forum start
Forummets regler
Sådan uploader du filer
Del dine regneark
Excel-regneark.dk
Opret folder efter cellenavn