Microsoft Excel

Herbers Excel/VBA-Archiv

Beim Klick auf Abbrechen Makro beenden

Betrifft: Beim Klick auf Abbrechen Makro beenden von: chandler
Geschrieben am: 05.11.2012 14:39:02

Hallo,

wenn im nachfolgenden Makro auf die Schaltfläche Abbrechen geklickt wird bleibt das Makro stehen und wird nicht beendet. On Error Resume Next hilft nicht.

Sub Test() 'Test
ChDrive Left(CurDir, 1)
ChDir CurDir
Dim z As Range
Dim search As String
Set wbtarget = ThisWorkbook.Worksheets("Tabelle1")
Dim Daten As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
search = wbtarget.Range("A1")
On Error Resume Next
Daten = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls),  *.xls", , "Excel")
Workbooks.Open Daten
Set wbsource = ActiveWorkbook.Worksheets("Tabelle1")

With wbsource
Do
Set z = Sheets("Tabelle1").Range("2:2").Find(what:=search)
Loop Until Not z Is Nothing
z.Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, Cells(Range(ActiveCell.Address).End(xlDown).Row, ActiveCell.Column)).Copy  _
Destination:=wbtarget.Range("A10")
ActiveWindow.Close
End With

wbtarget.Activate

Set wbtarget = Nothing
Set wbsource = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Kann mir jemand dabei helfen?
Vielen Dank. Gruß chandler

  

Betrifft: AW: Beim Klick auf Abbrechen Makro beenden von: Rudi Maintaire
Geschrieben am: 05.11.2012 15:01:17

Hallo,
if Daten="" then exit sub

Gruß
Rudi


  

Betrifft: AW: Beim Klick auf Abbrechen Makro beenden von: chandler
Geschrieben am: 05.11.2012 15:29:45

Hallo Rudi,

und so:
Daten = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls), *.xls", , "Excel")
If Daten = "" Then Exit Sub

Wenn ich mit F8 das Makro teste dann funktioniert es, mit der F5 leider nicht. Da bleibt die Sanduhr stehen das Makro wird nicht beendet.

Vielen Dank im Voraus. chandler


  

Betrifft: AW: Beim Klick auf Abbrechen Makro beenden von: guentherh
Geschrieben am: 05.11.2012 15:10:05

Probier mal

Sub Test() 'Test
ChDrive Left(CurDir, 1)
ChDir CurDir
Dim z As Range
Dim search As String
Set wbtarget = ThisWorkbook.Worksheets("Tabelle1")
Dim Daten As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
search = wbtarget.Range("A1")
' On Error Resume Next
Daten = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls),  *.xls", , "Excel")
if Daten <> false then
   Workbooks.Open Daten
   Set wbsource = ActiveWorkbook.Worksheets("Tabelle1")

   With wbsource
        Do
          Set z = Sheets("Tabelle1").Range("2:2").Find(what:=search)
        Loop Until Not z Is Nothing
        z.Select
        ActiveCell.Offset(1, 0).Select
        Range(ActiveCell, Cells(Range(ActiveCell.Address).End(xlDown).Row, ActiveCell.Column)). _
Copy  _
        Destination:=wbtarget.Range("A10")
        ActiveWindow.Close
   End With

   wbtarget.Activate

   Set wbtarget = Nothing
   Set wbsource = Nothing
end if

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Gruß,
Günther


  

Betrifft: Prima es funktioniert! von: chandler
Geschrieben am: 05.11.2012 15:33:06

Hallo Günther,

prima es funktioniert. Vielen Dank.

Grüße chandler


 

Beiträge aus den Excel-Beispielen zum Thema "Beim Klick auf Abbrechen Makro beenden"