Уважаемые Эксперты Макроса, Excel и VBA, прошу помочь разобраться с ошибкой в коде. Проблема в том, что после того как я в документе даю команду "нажмите дважды" должно печатать документ, но при подтверждении в окне печати я попадаю в бесконечный цикл и после чего зависает Макрос и выходит окно с такой ошибкой: "Microsoft Excel ожидает завершения ole-действия в другом приложении." Я предполагаю, что в этой части кода есть ошибка:
[vbа][cоde]
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
[/cоde][/vbа]
Уважаемые Эксперты Макроса, Excel и VBA, прошу помочь разобраться с ошибкой в коде. Проблема в том, что после того как я в документе даю команду "нажмите дважды" должно печатать документ, но при подтверждении в окне печати я попадаю в бесконечный цикл и после чего зависает Макрос и выходит окно с такой ошибкой: "Microsoft Excel ожидает завершения ole-действия в другом приложении." Я предполагаю, что в этой части кода есть ошибка:
[vbа][cоde]
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"
Roman090783, читаем Правила форума особенно п.2 и п.3. Оформлям код тэгами пояснялка здесь. и прикладываем файл пример. а также смотрим п.2 в части названия темы и меняем свое невнятное название и кстати да : а почему в разделе Вопросы по Excel для Mac? у вас Mac?
Roman090783, читаем Правила форума особенно п.2 и п.3. Оформлям код тэгами пояснялка здесь. и прикладываем файл пример. а также смотрим п.2 в части названия темы и меняем свое невнятное название и кстати да : а почему в разделе Вопросы по Excel для Mac? у вас Mac?китин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
