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