Störungsmeldung mit Variablem Wert
20.02.2018 13:48:48
Okan
ich habe folgendes Problem.
Ich würde gerne die unten stehenden Makros so laufen lassen, dass bei einem Error eine MsgBox mit Grundsätzlich dem steht was schon eingetragen wurde.
Einziger Makel an dem Makro ist, dass ich gerne die Tabellenblattbezeichnung (welche die Stationsbezeichnung ist) in der MsgBox stehen hätte anstatt Cells(7, 3).Value
Das Makro läuft bei start der Arbeitsmappe und Greift auf das unten stehende Makro zurück.
Private Sub Workbook_Open()
On Error GoTo ERR_HANDLER
Call Startseite_Übersicht
'Import Data für Abteilung CAR. Namentlich Sortiert wie in Speicherort
Call Import_Data(Sheets("Entnahme"))
Call Import_Data(Sheets("Feeder_2_S13A"))
Call Import_Data(Sheets("Feeder_2_S13B"))
Call Import_Data(Sheets("Feeder_2_S13C"))
Call Import_Data(Sheets("Kontrolle_100"))
Call Import_Data(Sheets("LV_140221"))
Call Import_Data(Sheets("LV_140231"))
Call Import_Data(Sheets("LV_140241"))
Call Import_Data(Sheets("LV_140311"))
Call Import_Data(Sheets("LV_140331"))
Call Import_Data(Sheets("LV_140341"))
Call Import_Data(Sheets("LV_160410"))
Call Import_Data(Sheets("LV_160411"))
Call Import_Data(Sheets("LV_160413"))
Call Import_Data(Sheets("LV_210311"))
Call Import_Data(Sheets("LV_210611"))
Call Import_Data(Sheets("LV_210621"))
Call Import_Data(Sheets("LV_211021"))
Call Import_Data(Sheets("LV_211411"))
Call Import_Data(Sheets("LV_211421"))
Call Import_Data(Sheets("LV_214511"))
Call Import_Data(Sheets("LV_214521"))
Call Import_Data(Sheets("LV_214611"))
Call Import_Data(Sheets("LV_214711"))
Call Import_Data(Sheets("LV_214811"))
Call Import_Data(Sheets("LV_214911"))
Call Import_Data(Sheets("LV_215211"))
Call Import_Data(Sheets("LV_215311"))
Call Import_Data(Sheets("LV_330111"))
Call Import_Data(Sheets("LV_330312"))
Call Import_Data(Sheets("LV_330511"))
Call Import_Data(Sheets("LV_330922"))
Call Import_Data(Sheets("LV_335131"))
Call Import_Data(Sheets("LV_335133"))
Call Import_Data(Sheets("LV_335211"))
Call Import_Data(Sheets("Reparatur"))
'Import Data für Abteilung .... Namentlich Sortiert wie in Speicherort
Exit Sub
ERR_HANDLER:
MsgBox "Es wurde ein Fehler in dem Sheet " & Cells(7, 3).Value & " gefunden." & vbCr & vbCr & " _
Bitte überprüfen Sie für den aktuellen Fehler im Windows Explorer:" & vbCr & "den Pfad des Speicherortes" & vbCr & "die Ordnerbezeichnungen" & vbCr & "die Dateinamen" & vbCr & vbCr & "Bitte überprüfen Sie für den aktuellen Fehler in dieser Excel-Arbeitsmappe:" & vbCr & "die Sheetsbezeichnung (auch im VBA)" & vbCr & "den Inhalt der Zellen C7 & C8 im aktuellen Fehlersheet" & vbCr & vbCr & "Wichtiger Hinweis: Es können nach beheben des aktuellen Fehlers weitere Fehlermeldungen für die danchfolgenden Sheets auftreten."
End Sub
Public Sub Import_Data(wks As Worksheet)
Dim objFileSearch As clsFileSearch
Dim lngIndex As Long, lngCount As Long
Dim varOutput As Variant
Dim strPath As String, strFormula As String
Const cstrTabname As String = "Report" 'Tabellenname
With wks
If .Range("C7") = "" Or .Range("C8") = "" Then
MsgBox ("Bitte Cellen C7 & C8 mit Daten füllen.")
Else
strPath = _
"I:\WDE_Quality\12_Lab\Partikelfallenanalyse\Analyse\" & .Cells(7, 3).Value & "\" & . _
Cells(8, 3).Value & "\" ' _
Startverzeichnis
If Right(strPath, 1) "\" Then strPath = strPath & "\"
.Range("B17:C36").ClearContents
Set objFileSearch = New clsFileSearch
With objFileSearch
.NewSearch = True
.CaseSenstiv = False
.Extension = "*.xlsx*"
.FolderPath = strPath
.SearchLike = "*Partikelfallenanalyse_CAR_" & wks.Name & "_*"
.SubFolders = False
If .Execute(Sort_by_Name, Sort_Order_Descending) > 0 Then
ReDim varOutput(1 To 20, 1 To 10)
lngCount = 1
For lngIndex = 1 To .FileCount
If lngCount > 20 Then Exit For
strFormula = "='" & .Files(lngIndex).FI_FolderPath
strFormula = strFormula & "[" & .Files(lngIndex).FI_FileName & "]"
strFormula = strFormula & cstrTabname & "'!"
varOutput(lngCount, 1) = strFormula & "U50"
varOutput(lngCount, 2) = strFormula & "I19"
varOutput(lngCount, 3) = strFormula & "I20"
varOutput(lngCount, 4) = strFormula & "I21"
varOutput(lngCount, 5) = strFormula & "I22"
varOutput(lngCount, 6) = strFormula & "I23"
varOutput(lngCount, 7) = strFormula & "I24"
varOutput(lngCount, 8) = strFormula & "I25"
varOutput(lngCount, 9) = strFormula & "I26"
varOutput(lngCount, 10) = strFormula & "U46"
lngCount = lngCount + 1
Next
End If
End With
With .Range("B17").Resize(UBound(varOutput, 1), 10)
.Formula = varOutput
.Value = .Value
End With
Set objFileSearch = Nothing
End If
End With
End Sub
VG
Okan