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: 5418
|
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: 5418
|
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: 5418
|
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: 5418
|
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: 5418
|
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: 5418
|
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.
|
|