341 Aufrufe
Gefragt in Tabellenkalkulation von peters Mitglied (460 Punkte)
Hallo zusammen,

ich möchte für Kundenaufträge die Vergabe fortlaufender Auftragsnummern automatisieren. Dabei wird von verschiedenen Arbeitsplätzen auf eine zentrale Datei mit den vorgenerierten Auftragsnummern zugegriffen.

Die zentrale Datei hat die Spalte A mit den bereits generierten Auftragsnummern, die Spalte B enthält bei Vergabe einer Nummer den entsprechenden Kundennamen, ist aber vorher leer.

Mein Grundgedanke ist, dass ich mittels VBA auf die zentrale Datei zugreife, diese öffne, in Spalte B das erste freie Feld suche, dort den Kundennamen eintrage, dann die entsprechende Auftragsnummer aus Spalte A auslese und dann die Datei wieder schließe und die Auftragsnummer in meiner Tabelle in Feld A1 eintrage.

Einen Plan habe ich, ich weiß nur nicht, wie das über VBA umzusetzen ist. Kann mir da jemand helfen?

Grüße

Peter

5 Antworten

+1 Punkt
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Peter,

hier mal ein Beispiel, wie so etwas aussehen könnte:

Sub Auftrag()

Dim wbAuftrag As Workbook
Dim lngLetzte As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Arbeitsmappe mit Auftragsnummern öffnen - Pad und Name anpassen
Set wbAuftrag = Workbooks.Open("C:\Test\Auftragsnummer.xlsx")

'In Arbeitsmappe mit Auftragsnummern in Spalte B die letzte beschriebene Zeile ermitteln und um 1 erhöhen
With wbAuftrag.Worksheets(1)
    lngLetzte = .Cells(Rows.Count, 2).End(xlUp).Row + 1
End With

'Auftragsnummer in aktuelle Datei schreiben - Bezug anpassen
ThisWorkbook.ActiveSheet.Range("B3") = wbAuftrag.Worksheets(1).Cells(lngLetzte, 1).Value

'Name der Firma in Auftragsdatei schreiben - Bezüge anpsssem
wbAuftrag.Worksheets(1).Cells(lngLetzte, 2) = ThisWorkbook.ActiveSheet.Range("B2").Value

'Datei mit Auftragsnummern speichern und schließen
wbAuftrag.Close (True)

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Der Name des Kunden steht in Zelle B2, die Auftragsnummer wird in Zelle B3 eingetragen. Das Makro gehört in ein Standardmodul der Arbeitsmappe, in der du die Auftragsnummer übernehmen willst. Den Pfad, den Namen und die Bezüge musst du natürlich auf deine Verhältnisse anpassen. Ich gehe davon aus, dass in der Arbeitsmappe mit den Auftragsnummern die Nummern im ersten Blatt stehen.

Beachte aber, dass es Probleme geben kann, wenn mehrere Personen gleichzeitig versuchen auf die Mappe zuzugreifen.

Gruß

M.O.

0 Punkte
Beantwortet von peters Mitglied (460 Punkte)
Bearbeitet von peters
Hallo Mo,

danke erstmal für die ausführliche Antwort. Ich habe das getestet und es funzt sehr gut.
Um die wiederholte Ausführung des Codes zu verhindern - dann bekäme ich immer wieder neue Auftragsnummern und die Tabelle mit den Auftragsnummern wird sinnfrei mit immer dem gleichen Kundennamen gefüllt - bastel ich mir noch eine Vorababfrage über eine Hilfszelle, worin sinngemäß steht "wurde bereits ausgeführt ja/nein".

Bzgl. des gemeinsamen Zugriffs hatte ich mir überlegt, dass es ja recht unwahrscheinlich ist, dass zufällig gerade 2 Benutzer zeitgleich auf die Datei zugreifen. Diese ist ja auch nur für 1-2 Sekunden geöffnet und damit blockiert.

Besteht denn die Möglichkeit den Zustand der Datei (geöffnet/ungeöffnet) abzufragen? Dann könnte ich das Ganze im Falle des Geöffnetseins abfangen und eine schlichte Hinweisbox ausgeben.

Gruß

Peter
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Peter,

zur Frage, ob eine Datei bereits geöffnet ist, schau dir mal das hier an: KLICK

Gruß

M.O.

0 Punkte
Beantwortet von peters Mitglied (460 Punkte)
Bearbeitet von peters
Hallo Mo,

danke, das probierte ich gleich, die MsgBox gab auch den richtigen Wert aus.

Nur: Wie bastele ich das in eine Abfrage in meinen Code hinein?
Also wie sieht so eine If...then...else-Konstruktion dazu aus?

Gruß

Peter
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Peter,

das könnte so aussehen:

Sub Auftrag()

Dim wbAuftrag As Workbook
Dim lngLetzte As Long
Dim strAuftrag As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad und Dateiname der Auftragsdatei festlegen
strAuftrag = "C:\Test\Auftragsnummer.xlsx"

'Prüfen, ob Datei bereits geöffnet
If DateiGeoeffnet(strAuftrag) = True Then
  MsgBox "Die Auftragsdatei wird gerade genutzt. Bitte versuchen Sie es in paar Minuten wieder"
  Exit Sub
End If

'Arbeitsmappe mit Auftragsnummern öffnen - Pad und Name anpassen
Set wbAuftrag = Workbooks.Open(strAuftrag)

'In Arbeitsmappe mit Auftragsnummern in Spalte B die letzte beschriebene Zeile ermitteln und um 1 erhöhen
With wbAuftrag.Worksheets(1)
    lngLetzte = .Cells(Rows.Count, 2).End(xlUp).Row + 1
End With

'Auftragsnummer in aktuelle Datei schreiben - Bezug anpassen
ThisWorkbook.ActiveSheet.Range("B3") = wbAuftrag.Worksheets(1).Cells(lngLetzte, 1).Value

'Name der Firma in Auftragsdatei schreiben - Bezüge anpsssem
wbAuftrag.Worksheets(1).Cells(lngLetzte, 2) = ThisWorkbook.ActiveSheet.Range("B2").Value

'Datei mit Auftragsnummern speichern und schließen
wbAuftrag.Close (True)

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Private Function DateiGeoeffnet(DerPfad As String) As Boolean
' Bei shared Workbooks, schreibgeschützten Mappen o.ä.. kann dies auch ein falsch zurückgeben.
    On Error Resume Next
    Open DerPfad For Binary Access Read Lock Read As #1
    Close #1
    If Err.Number <> 0 Then
        DateiGeoeffnet = True
        Err.Clear
    End If
End Function


Gruß

M.O.

...