24. september 2007 - 10:30Der er
7 kommentarer og 1 løsning
excell VBeditor gemme filnavn ved hjælp af variabler
Sti = ThisWorkbook.Path & "\" ' definer sti hvor skabelon skal gemmes som anden fil Navn = Range("A1").Value ' sæt variablen NAVN lig værdien i cellen A1
Navn = Replace(Navn, "/", "_") 'Erstatter slash med underscore Navn = Replace(Navn, ".", " ") 'Erstatter punktum med underscore Navn = Replace(Navn, ",", " ") 'Erstatter komma med underscore
Denne kode fungerer fint. Men.. jeg vil gerne have at hvis koden skulle støde på samme navn mere end 1 gang skal den tilføje eksempelvis "2" til filnavnet. Nogen ide til hvordan det skal kodes?
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Public Sub test() Dim Nr As Variant sti = ThisWorkbook.Path & "\" ' definer sti hvor skabelon skal gemmes som anden fil Navn = Range("A1").Value ' sæt variablen NAVN lig værdien i cellen A1 Nr = Empty Navn = Replace(Navn, "/", "_") 'Erstatter slash med underscore Navn = Replace(Navn, ".", " ") 'Erstatter punktum med underscore Navn = Replace(Navn, ",", " ") 'Erstatter komma med underscore Do Until EksistererFil(sti & Navn & Nr) = False Nr = Nr + 1 Loop EksistererFil (sti & Navn) 'gem fil ved hjælp af variabler.
ActiveWorkbook.SaveAs Filename:= _ sti & Navn & Nr, FileFormat:=xlNormal _ , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False End Sub
Public Function EksistererFil(FilOgSti) As Boolean
If Dir(FilOgSti & ".xls") <> "" Then EksistererFil = True Else EksistererFil = False End If End Function
Public Sub test() Dim Nr As Variant sti = ThisWorkbook.Path & "\" ' definer sti hvor skabelon skal gemmes som anden fil Navn = Range("A1").Value ' sæt variablen NAVN lig værdien i cellen A1 Nr = Empty Navn = Replace(Navn, "/", "_") 'Erstatter slash med underscore Navn = Replace(Navn, ".", " ") 'Erstatter punktum med underscore Navn = Replace(Navn, ",", " ") 'Erstatter komma med underscore Do Until EksistererFil(sti & Navn & Nr) = False Nr = Nr + 1 Loop
'gem fil ved hjælp af variabler.
ActiveWorkbook.SaveAs Filename:= _ sti & Navn & Nr, FileFormat:=xlNormal _ , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False End Sub
Public Function EksistererFil(FilOgSti) As Boolean
If Dir(FilOgSti & ".xls") <> "" Then EksistererFil = True Else EksistererFil = False End If End Function
HMM er stødt på et nyt problem... nogle navne indeholder tegnet ' " ' og det kan jeg ik lige finde ud af at lave replace på, editoren brokker sig hvis jeg laver
Navn = Replace(Navn, " " ", " ") 'Erstatter gåseøjne med mellemrum
There ya go mate. Det er blevet rigtig godt. Makro'n henter nu et nr fra en liste, slår op i en database ud fra nr, returnerer resultatet af en sql forespørgelse til excell arket, gemmer arket med det tilsvarende navn, tjekker om filnavnet eksisterer (den kender du jo;) ), springer videre til næste nummer i listen på det andet excell ark og looper fint derud af. sparede mig lige for rigtig mange timers repetitions abe arb. :D
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.