18. juni 2004 - 11:20Der er
11 kommentarer og 1 løsning
Macro - Ved fejl gaa til et andet sted automatisk (stop ikke)
Jeg har fundet frem til denne Macro (MacroinAllWorkbooks, som jeg tror er brugbar for mange), der aabner alle workbooks i en mappe ("C:\Test") og udfoerer en macro (Macro1) i arket "ark1". Mit problem er, at hvis der ikke er et "ark1" saa stopper macroen med en fejlmeddelese. Jeg har provet at satte en linie ind med If is Error eller On Error, med jeg har ikke kunnet faa det til at virke. Jeg ved ikke helt hvordan jeg skal faa det til at virke. I stedet for for fejlmeddelselsen, vil jeg gerne have at macroen gaar videre til naeste ark. (Evt efter foerst at have proevet at gaa til "Ark2")
Hermed macroen, jeg vil gerne have vist hvor On error eller hvad det er for en kommando, der skal bruges skal saettes ind.
Sub MacroinAllWorkbooks() Dim fn As String, sht As Variant Application.ScreenUpdating = False TargetFolder = "C:\Test" If Right(TargetFolder, 1) <> Application.PathSeparator Then TargetFolder = TargetFolder & Application.PathSeparator End If If FileFilter = "" Then FileFilter = "*.xls" fn = Dir(TargetFolder & FileFilter) ' the first file name in the folder While Len(fn) > 0 If fn <> ThisWorkbook.Name Then Application.StatusBar = "Udfoerer Macro " & fn & "..." Workbooks.Open TargetFolder & fn
Sheets("Ark1").Select
Application.Run "'Personal.xls'!Macro1"
ActiveWorkbook.Close False End If fn = Dir ' the next file name in the folder Wend Application.StatusBar = False End Sub
-> Kabbak, det betyder at jeg tager det foreste ark i hver workbook, og det er jeg ikke interesseret i, jeg er interesseret i at tage netop det ark med navnet "ark1" eller maaske et ark med navnet "Regnskab". Hvis arket ikke eksisterer, saa gaa til naeste workbook. Saa det skal altsaa vaere en rutine der checker om arket eksisterer, hvis ikke gaa til ...... ELLER Hvis fejl gaa til.
Jeg har kun forsoegt mig frem med hvis fejl (On error) og har ikke kunnet faa det til at virke, men det skal tilfoejes, at jeg ikke mestrer denne kommando saerlig godt.
Private Function SheetExists(sname) As Boolean Dim x As Object On Error Resume Next Set x = ActiveWorkbook.Sheets(sname) If Err = 0 Then SheetExists = True Else SheetExists = False End Function
Sub MacroinAllWorkbooks() Dim fn As String, sht As Variant Application.ScreenUpdating = False TargetFolder = "C:\Test" If Right(TargetFolder, 1) <> Application.PathSeparator Then TargetFolder = TargetFolder & Application.PathSeparator End If If FileFilter = "" Then FileFilter = "*.xls" fn = Dir(TargetFolder & FileFilter) ' the first file name in the folder While Len(fn) > 0 If fn <> ThisWorkbook.Name Then Application.StatusBar = "Udfoerer Macro " & fn & "..." Workbooks.Open TargetFolder & fn
If SheetExists("Ark1") = True Then Sheets("Ark1").Select Else GoTo JumpThis
Application.Run "'Personal.xls'!Macro1" JumpThis: ActiveWorkbook.Close False End If fn = Dir ' the next file name in the folder Wend Application.StatusBar = False End Sub
-> Bak Det virker naar jeg bruger din Check-function. Faktisk er det loesningen, jeg bedst kan lide, den kan udbygges til at udfoere forskellige macroer for forskellige ark i en Workbook. Mange tak (0gsaa til Kabbak) P.S! Jeg kan stadigvaek ikke forstaa hvorfor min On Error kommando ikke virker.
Sub MacroinAllWorkbooks() Dim fn As String, sht As Variant Application.ScreenUpdating = False TargetFolder = "C:\Test" If Right(TargetFolder, 1) <> Application.PathSeparator Then TargetFolder = TargetFolder & Application.PathSeparator End If If FileFilter = "" Then FileFilter = "*.xls" fn = Dir(TargetFolder & FileFilter) ' the first file name in the folder While Len(fn) > 0 If fn <> ThisWorkbook.Name Then Application.StatusBar = "Udfoerer Macro " & fn & "..." Workbooks.Open TargetFolder & fn on error goto handleerror Sheets("Ark1").Select
Application.Run "'Personal.xls'!Macro1" handlerror: ActiveWorkbook.Close False End If fn = Dir ' the next file name in the folder Wend Application.StatusBar = False End Sub
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.
