Microsoft Exel wartet auf die Beendigung einer OLE-Aktion in einer anderen Anwendung.

Sehr geehrte Makroexperten, Excel und VBA,
Ich bitte Sie, den Fehler im Code zu finden. Das Problem ist, dass ich, nachdem ich den Befehl "Doppelklick" im Dokument einklicke, das Dokument ausdrucken muss. Wenn ich jedoch im Druckfenster bestätige, gerate ich in eine Endlosschleife, und dann bleibt das Makro hängen, und ein Fenster mit der folgenden Fehlermeldung wird angezeigt: "Microsoft Exel wartet auf die Beendigung einer OLE-Aktion in einer anderen Anwendung"
Ich gehe davon aus, dass in diesem Teil des Codes ein Fehler vorliegt:


Sub Auswahl_Arbeitsblatt(ByVal R_Target As Range, ByRef Bezeichner As String, ByRef AktZeile As Long)

' Routine ermittelt nach Selektion den Bezeichner für die Drucküberschrift und die ausgewählte Zeile

' ___________________________________________________________________________________________________

Dim C As Long

Dim R As Long

Dim Teil1 As String

Dim Teil2 As String

Dim Delimiter As String



On Error GoTo err_exit

Bezeichner = ""

AktZeile = 0

If R_Target.Row < 4 Then Exit Sub ' nur ab 4.Zeile



' Einzelzeile übernehmen

R = R_Target.Row

'nur bei Doppelklick in Spalte 4



C = R_Target.Column

If C <> 4 Then

Exit Sub

End If

' Ausgabe selektierte Zeile

AktZeile = R

l = 1

' Bezeichner zusammensetzen (1 links und aktuelle Zelle)

Teil1 = ActiveCell.Offset(0, -1)

Teil2 = ActiveCell.Offset(0, 0)

' Ausgabe Bezeichner

If Teil1 <> "" And Teil2 <> "" Then

Delimiter = " - "

Bezeichner = Trim(Teil1) + Delimiter + Trim(Teil2)

Else

MsgBox "Auwahl nicht erfolgreich!", vbCritical

AktZeile = 0

Exit Sub

End If

Exit Sub

err_exit:

MsgBox "Fehler: " & CStr(Err.Number) & vbLf & "Auswahl_Arbeitsblatt" & vbLf & _

Err.Description, vbCritical, "Fehlermeldung"

End Sub

Sub Dateiname_bereitstellen(Index As Integer, Dateiname As String, KZ_Inventur As Integer)

' Aus der Konfiguration wird der Dateiname ermittelt

' _______________________________________________________________

Dim TB2 As Worksheet

Dim Delimiter As String

Dim Datei As String

Dim Pfad As String

Dim lngRow As Long

Dim Vgl As Integer

Dim Anz As Integer

Dim Steuerung As Variant



On Error GoTo err_exit

Dateiname = ""

KZ_Inventur = 0

Set TB2 = ActiveWorkbook.Sheets(2)



With TB2

Anz = .Cells(.Rows.Count, 1).End(xlUp).Row

For lngRow = 2 To Anz

If .Cells(lngRow, 1).Value = "Quellverzeichnis" Then

Pfad = .Cells(lngRow, 3).Value

Delimiter = Right(Pfad, l)

If Delimiter <> "\" Then

Pfad = Trim(Pfad) + "\"

End If

End If

Steuerung = Trim(.Cells(lngRow, 1).Value)

If lngRow = 24 Then

KZ_Inventur = 0

End If

If Steuerung = "Mapping" Or Steuerung = "Inventur" Then

Vgl = CInt(.Cells(lngRow, 2).Value)

If Steuerung = "Inventur" Then

KZ_Inventur = 1

End If

If Vgl = Index Then

Datei = .Cells(lngRow, 3).Value

Exit For

End If

End If

Next

End With

' Wenn Kein Eintrag für Datei, wird Dateiname insgesamt auf Leerwert gesetzt

If Datei = "" Then

Dateiname = ""

Else

Dateiname = Pfad + Datei

End If

Exit Sub

err_exit:

MsgBox "Fehler: " & CStr(Err.Number) & vbLf & "Dateiname bereitstellen" & vbLf & _

Err.Description, vbCritical, "Fehlermeldung"

End Sub

Sub Dateien_Drucken(Bezeichnung As String, AktZeile As Long)

' Umfassende Routine zur Verarbeitung nach Konfiguration

' __________________________________________________________

Dim TB As Worksheet

Dim Von As Integer

Dim Bis As Integer

Dim Anz As Integer

Dim Inh As Variant

Dim Z As Integer

Dim Inventur_Kennung As Integer



Dim lngRow As Long



Dim Dateiname As String

Dim KZ_Inventur As Integer

Dim Fehler As Boolean

Dim Dt_Wert As Variant



Fehler = False

On Error GoTo err_exit



' Konfiguration durchsuchen

Set TB = ActiveWorkbook.Sheets(2)



With TB

Anz = .Cells(.Rows.Count, 1).End(xlUp).Row

For lngRow = 2 To Anz

If .Cells(lngRow, 1).Value = "Bereich von" Then

Von = CInt(.Cells(lngRow, 2).Value)

End If

If .Cells(lngRow, 1).Value = "Bereich bis" Then

Bis = CInt(.Cells(lngRow, 2).Value)

End If

If Von > 0 And Bis > 0 Then

Exit For

End If

Next

End With

' Zeile in Tabelle 1 durchsuchen

Set TB = ActiveWorkbook.Sheets(1)

For Z = Von To Bis

Inh = ""

Inh = TB.Cells(AktZeile, Z).Value

If Inh > "" And Inh <> "0" Then

' Dateiname ermitteln

Call Dateiname_bereitstellen(Z, Dateiname, KZ_Inventur)

'Wenn Inveturliste in Vergangenheit schon einmal ausgedruckt wurde, kein weiterer Ausdruck

Dt_Wert = TB.Cells(AktZeile, Bis + 1).Value



If Dt_Wert = "" Then

Dt_Wert = Date + 1

End If



If KZ_Inventur = 1 And Dt_Wert <= Date Then

' kein Ausdruck

Else

If Dateiname <> "" Then

' Datei ausdrucken

Call Mappe_oeffnen(Dateiname, Bezeichnung, Fehler)

Inventur_Kennung = KZ_Inventur

End If

End If

End If

If Fehler Then

Exit For

End If

Next

If Not Fehler Then

If Inventur_Kennung = 1 Then

TB.Cells(AktZeile, Bis + 1).Value = Date

End If

End If

Exit Sub

err_exit:

MsgBox "Fehler: " & CStr(Err.Number) & vbLf & "Dateien drucken" & vbLf & _

Err.Description, vbCritical, "Fehlermeldung"





End Sub