mein Problem besteht darin das die Kommunikation zwischen 3 verschiedenen Exceldateien nicht ganz vollständig und einwandfrei funktioniert.
1.) MasterFV (.xls) gespeichert auf Server mit variablen Speicherort
2.) Übersicht (.xls) gespeichert auf meiner Festplatte
3.) MusterLK (.xlt) gespeichert auf meiner Festplatte
Meine Ausgangssituation:
Ich habe eine Exceldatei (Fertigungsfolge) die von einer Person "XXX" ausgefüllt werden muß, allerdings nach MEINER Vorlage. So ist garantiert das egal wer diese Datei mit Leben füllt das gleiche Format vorliegen hat. Ich persönlich habe mir eine Übersichtsdatei gebastelt in der folgendes ablaufen soll:
a) öffnen der MasterFV über Eingabe Pfad in TextBox funktioniert
b) kopieren der von mir benötigten Daten aus MasterFV in Übersicht funktioniert
c) schließen dieser Datei funktioniert
d) öffnen von MusterLK funktioniert
e) einfügen der oben herrauskopierten Daten in den Arbeitsauftrag + Übernahme von Informationen aus verschiedenen ComboBoxen + Übernahme einen JA / NEIN Information aus verschiedenen CheckBoxen funktioniert nicht
f) Übernahme des Auftrages in die Übersicht --> funktioniert
Das ganze möchte ich realisieren über eine selbstkreierten Userform.
Dieser besteht aus einen Eingabefeld = Angabe Pfad der Exceldatei von Person "XXX"
Verschiedene ComboBoxen = Angabe der richtigen Fertigungsfolge + Übernahme in MusterLK
Verschiedene CheckBoxen = Angabe JA / Nein Information zu den entsprechenden Fertigungsschritten + Übnahme in MusterLK
Anbei sende ich euch den derzeit aktuellen Makro:
Option Explicit
Dim strverzeichnis$
Dim Dat
'Dim Musterlaufkarte
Private MasterFV As Collection
Private Musterlaufkarte As Collection
Private Sub ERSTELLEN_Click()
Dim Dat
Dim MusterLK
Dim i As Integer
Dim j As Integer
Dat = DateipfadTB.Value
Workbooks.Open Dat
Application.FileSearch.NewSearch
Application.FileSearch.LookIn = Application.ActiveWorkbook.Path
Application.FileSearch.FileType = msoFileTypeExcelWorkbooks
Application.FileSearch.Execute
Set MasterFV = New Collection
For i = 1 To Application.FileSearch.FoundFiles.Count
If GetObject(Application.FileSearch.FoundFiles(i)).Worksheets(1).Cells(5, 8) = " _
Fertigungsvorschrift" Or GetObject(Application.FileSearch.FoundFiles(i)).Worksheets(1).Cells(5, 8) = "Fertigungsanweisung" Then
'Suche nach dem Wort "xxx" in der linken, oberen Zelle der FA-FV
MasterFV.Add GetObject(Application.FileSearch.FoundFiles(i))
'wenn "xxx" in der Datei gefunden, wird sie geöffnet
End If
Next
For i = 1 To MasterFV.Count
'Kopie von allen benötigten Datein aus der FA-FV
Tabelle2.Cells(4, 6) = MasterFV(i).Worksheets(1).Cells(6, 5) Information 1
Tabelle1.Cells(4, 3) = MasterFV(i).Worksheets(1).Cells(6, 5) ' Information 2
Tabelle2.Cells(4, 7) = MasterFV(i).Worksheets(1).Cells(9, 14) ' Information 3usw.
MasterFV(i).Close SaveChanges:=False
Next
'Ort von "02_Vorlage_MlK_1.0.xls" + öffnen dieser Datei
MusterLK = "D:\Eigene Dateien\02_Projekte\FV_NEU\03_Durchführung_MB_Planung\02_Vorlage_MlK_1. _
0_StiA.xlt"
Workbooks.Open MusterLK
Application.FileSearch.NewSearch
Application.FileSearch.LookIn = Application.ActiveWorkbook.Path
Application.FileSearch.FileType = msoFileTypeExcelWorkbooks
Application.FileSearch.Execute
Set MusterLK = New Collection
For i = 1 To Application.FileSearch.FoundFiles.Count
If GetObject(Application.FileSearch.FoundFiles(i)).Worksheets(1).Cells(43, 1) = "Laufkarte fü _
r Mustercharge Nr: " Then
'Suche nach dem Wort "xxx" in der linken, oberen Zelle des Excel-Messberichts
MusterLK.Add GetObject(Application.FileSearch.FoundFiles(i))
'wenn "xxx" in der Datei gefunden, wird sie zur Auswertung herangezogen
End If
Next
For i = 1 To MusterLK.Count
'Ausfüllen der Musterlaufkarte mit allen wichtigen Informationen
MusterLK.Worksheets(1).Cells(47, 3) = Worksheets(2).Cells(4, 6) Info 1
MusterLK(i).Worksheets(1).Cells(47, 5) = Worksheets(2).Cells(4, 7) Info 2 usw.
MusterLK(i).Worksheets(1).Cells("B2") = ComboBox1.Value
If CheckBox1 = True Then
MusterLK(i).Worksheets(1).Cells(73, 5) = "ja"
Else
MusterLK(i).Worksheets(1).Cells(73, 5) = "nein"
End If
Next
Unload Me
'In Auftragsübersicht übernehmen
Dim zeile As Integer
Dim startzeile As Integer
Dim spalte As Integer
startzeile = 8
zeile = 8
spalte = 1
Do Until Tabelle2.Cells(zeile, 1) = ""
zeile = zeile + 1
Loop
Do Until spalte = 22
Tabelle2.Cells(zeile, spalte) = Tabelle2.Cells(4, spalte)
spalte = spalte + 1
Loop
'Tabelle2.Range(Cells(4, 1), Cells(4, spalte)) = "" '-> leeren dieser Zeile
Tabelle2.Cells(4, 3) = Tabelle2.Cells(zeile, 3) + 1
Tabelle2.Cells(4, 2) = "/"
Tabelle2.Cells(4, 1) = Date
Cells(4, 4).Select
End Sub
Vielen Dank vorab für eine schnelle Hilfe!
Gruß Alex