Visualisierung der Durchlaufzeit einer Produktstruktur mit Excel-Tool

Die Entscheidung einen Artikel oder eine Baugruppe zu bevorraten oder Just-In-Time zu produzieren ist nicht leicht zu treffen. Wenn Sie den Artikel Bestandssenkung durch beschaffungszeitliche Visualisierung der Produktstruktur lesen, erleichtert das vorgestellte Tool Ihre Wahl hoffentlich ein wenig.

Liegen Ihnen aber nicht die notwendigen Daten vor, haben sie eine andere Produktstruktur, haben Sie eine Idee für eine bessere Visualisierung oder möchten wissen, was unter der Motorhaube des Tools passiert? Dann sind Sie hier richtig.

In diesem Artikel erfahren Sie, wie das Excel-Tool zur beschaffungszeitlichen Visualisierung der Produktstruktur im Detail funktioniert. Damit haben Sie die Möglichkeit, die richtigen Stellen zu finden, um das Tool nach Ihren Bedürfnissen anzupassen.

Die notwendige Excel-Datei mit dem VBA Quellcode können Sie hier downloaden.

Datenquellen

Für die Visualisierung sind die im Artikel beschriebenen Daten notwendig. Dafür gibt es die zugehörigen Tabellen:

Stückliste
Artikel
Arbeitsplan
Arbeitsplatz

Die VBA-Routine findet die entsprechenden Felder über die Spaltennummer. Daher ist der Aufbau verbindlich. Die Namen der Tabellen lassen sich aber im Quellcode unter den globalen Konstanten ändern (ab Codezeile 3).

Global Const tabParameter = "Parameter"

Eingabe-Parameter

Das Tool benötigt für die Visualisierung Vorgaben. Das sind produktseitig die Produkt-Artikelnummer, die Produktmenge und die vom Kunden erwartete Lieferzeit. Darstellungseitig sind Formatierungsvorgaben, wie Shape-Höhe und ein Skalierungsfaktor zur Umrechnung von Durchlaufzeit-Tagen in Excel points notwendig.

Diese Felder haben jedes einen Namen bekommen. Die Namen sind im Quellcode in den Codezeilen ab 10 definiert.

Global Const eingabeProduktArtikelnummer = "eingabeProduktArtikelnummer"

Visualisierung berechnen

Vorbereitungen

Die Sub VisualisierungBerechnen startet die Neuberechnung der Produktstruktur.

Als erste Aktion wird eine ggf. vorhandene Darstellung auf der Tabelle Visualisierung gelöscht. Im nächsten Schritt liest die Routine die Eingabe Parameter über die Feldnamen ein. Die Namen gelten global im Dokument. Der Zugriff erfolgt mit der Funktion Range. Rückgabewert ist der jeweilige Feldinhalt.

Call VisualisierungLöschen

produktArtikelnummer = Range(eingabeProduktArtikelnummer)
produktMenge = Range(eingabeProduktMenge)
erwartungKunde = Range(eingabeErwartungKunde)
skalierungX = Range(eingabeSkalierungX)
shapeHöhe = Range(eingabeShapeHöhe)

Die Produktstruktur muss irgendwo beginnen. Dafür gibt es die Koordinaten x0 und y0. Sie legen den Ursprung fest. Der X-Wert liegt bei 5 points, also etwas rechts vom linken Rand. Der y-Startwert beginnt nach der ersten Zeile, der Überschrift.

x0 = 5
y0 = Sheets(tabVisualisierung).Cells(1, 1).RowHeight

Rekursive Produktstruktur

Im nächsten Schritt startet die Routine den rekursiven Algorithmus ProduktstrukturBerechnen(artikelnummer As String, menge As Double, x As Double, shapeName As String). Dort ist die Logik zum Aufbauen der Produktstruktur-Visualisierung untergebracht.

Call ProduktstrukturBerechnen("Produkt", produktMenge, x0, "")

Der erste Aufruf erfolgt mit den Startbedingungen. Die Artikelnummer ist am Startpunkt immer „Produkt“. In der Tabelle Stückliste findet eine Verknüpfung zur Stückliste „Produkt“ mit dem ausgewählten Artikel statt. Das ist notwendig, da auch das Produkt visualisiert werden soll. Das funktioniert im rekursiven Algorithmus nur, wenn das Produkt als Artikel in einer Stücklisten-Artikelnummer vorkommt.

Das visualisierte Produkt muss auch als Artikel in einer Stückliste vorkommen

Ab der Codezeile 92 befinden sich die deklarierten internen Variablen. Das sind vorwiegend Variablen der Feldinhalte aus den Datenquellen.

Stücklisten-Informationen einlesen

Die Hauptroutine besteht aus einer do-until-Schleife. Sie durchläuft die Stücklisten Tabelle und prüft, wo die übergebene Artikelnummer zur Stückliste passt.

i = 1
Do
  i = i + 1
  If artikelnummer = Sheets(tabStückliste).Cells(i, 1) Then
    …
  End If
Loop Until Sheets(tabStückliste).Cells(i + 1, 1) = ""

Ist eine Übereinstimmung gefunden, liest der Algorithmus die Stücklisten-Daten ein.

stücklistenArtikel = Sheets(tabStückliste).Cells(i, 2)
stücklistenMenge = Sheets(tabStückliste).Cells(i, 4)

Artikeldaten einlesen

Die weiteren Daten stehen in der Artikel Tabelle. Um diese Daten einzulesen, gibt es eine Funktion FindeZeile, die entsprechende Zeile zu finden. Als Parameter werden der Tabellenname, die Spaltennummer (in der gesucht werden soll) und der Suchbegriff übergeben. Rückgabewert ist die gefundene Zeilennummer oder -1, wenn nichts gefunden wird.

zeile = FindeZeile(tabArtikel, 1, stücklistenArtikel)
If zeile = -1 Then
  Call MeldungAusgeben("Warnung", "Artikel nicht gefunden: " & stücklistenArtikel)
  Exit Sub
End If

Liefert also FindeZeile einen Wert >=0 zurück, gibt es in der Artikeltabelle einen passenden Artikel mit weiteren Daten zum Einlesen. Wenn nicht wird eine Fehlerinformation in die Parametertabelle geschrieben.

artikelBezeichnung = Sheets(tabArtikel).Cells(zeile, 2)
artikelArt = Sheets(tabArtikel).Cells(zeile, 3)
artikelBeschaffungszeit = Sheets(tabArtikel).Cells(zeile, 4)
artikelLosgröße = Sheets(tabArtikel).Cells(zeile, 5)
artikelLieferant = Sheets(tabArtikel).Cells(zeile, 6)

Die hier vorgestellte Möglichkeit ist Excel-technisch nicht die schnellste, um Daten in Tabellen zu finden. Alternativ könnte auch die schnellere interne Excel-Funktion SVERWEIS/ WorksheetFunction.VLookup genutzt werden.

Arbeitsplandaten einlesen

Da aber im nächsten Schritt aus der eingelesenen Artikelnummer jetzt Arbeitsplandaten auf die gleiche Weise gesucht werden, passt die Logik sehr gut.

Das ist aber nur notwendig, wenn es sich um ein Fertigungsteil handelt.

If artikelArt = "F" Then 
  zeile = FindeZeile(tabArbeitsplan, 1, stücklistenArtikel)
  If zeile = -1 Then
    Call MeldungAusgeben("Warnung", "Arbeitsplan nicht gefunden: " & stücklistenArtikel)
  Exit Sub
End If

In einem Arbeitsplan sind i.d.R. mehrere Arbeitsfolgen enthalten. Hier reicht es nicht nur den ersten Wert zu lesen. Es ist ein weitere do-until-Schleife notwendig.

Wichtig ist, dass die Arbeitsplandaten in der richtigen Reihenfolge vorliegen. Und zwar absteigend nach der Arbeitsfolgenummer sortiert. Das ist notwendig, damit die zeitliche Darstellung der Produktstruktur stimmt. Diese wird ja quasi vom Endzeitpunkt her aufgebaut.

Im Arbeitsplan ist eine absteigende Sortierung der Arbeitsfolgenummer notwendig

In der Schleife berechnet der Algorithmus die Durchlaufzeit für jede Arbeitsfolge aus der Summe von:

Rüstzeit * Losanzahl
Bearbeitungszeit * Menge
Wartezeit vorher
Wartezeit nachher

Arbeitsplatzdaten einlesen

Die Wartezeiten liegen bereits in der Einheit Tage vor. Die Rüstzeit und Bearbeitungszeit müssen über die Tageskapazität umgerechnet werden. Dafür wird nochmals die Funktion FindeZeile mit dem Arbeitsplatz aufgerufen, um die Tageskapazität zu bekommen.

j = zeile - 1
Do
  j = j + 1

  aplanFolgenummer = Sheets(tabArbeitsplan).Cells(j, 2)
  aplanArbeitsplatz = Sheets(tabArbeitsplan).Cells(j, 3)
  aplanRüstzeit = Sheets(tabArbeitsplan).Cells(j, 4)
  aplanBearbeitungszeit = Sheets(tabArbeitsplan).Cells(j, 5)
  aplanWartezeitVorher = Sheets(tabArbeitsplan).Cells(j, 6)
  aplanWartezeitNachher = Sheets(tabArbeitsplan).Cells(j, 7)

  zeile = FindeZeile(tabArbeitsplatz, 1, aplanArbeitsplatz)
  If zeile = -1 Then
    Call MeldungAusgeben("Warnung", "Arbeitsplatz nicht gefunden: " & aplanArbeitsplatz)
    Exit Sub
  End If

  tageskapazität = Sheets(tabArbeitsplatz).Cells(zeile, 3)
  If tageskapazität = 0 Then tageskapazität = 8

  dlzafo = aplanWartezeitVorher + (aplanRüstzeit * lose / 60 + aplanBearbeitungszeit * stücklistenMenge * menge / 60) / tageskapazität + aplanWartezeitNachher

  dlz = dlz + dlzafo
  Call ShapeEinfügen(x, y + shapeHöhe / 2, SkaliereX(dlzafo), aplanArbeitsplatz, "Afo")
  ...

  x = x + SkaliereX(dlzafo)
Loop Until Sheets(tabArbeitsplan).Cells(j + 1, 1) <> stücklistenArtikel

Im letzten Schritt wird die Sub ShapeEinfügen aufgerufen. Was dort passiert schauen wir uns später an.

Zusätzliche Informationen anzeigen

Die vielen Informationen werden in der Visualisierung bei kleinen Rüst- oder Bearbeitungszeiten nicht angezeigt. In Excel gibt es aber den Alternativtext. Dieser lässt sich nutzen, um zusätzliche Informationen zu speichern und anzuzeigen. Das nutze ich hier und hinterlege die Informationen zur Arbeitsfolge als AlternativeText.

Selection.ShapeRange.AlternativeText = "Afo " & aplanFolgenummer & vbCrLf & _
    "Arbeitsplatz: " & aplanArbeitsplatz & vbCrLf & _
    "Rüstzeit [min]: " & aplanRüstzeit & vbCrLf & _
    "Bearbeitungszeit [min]: " & aplanBearbeitungszeit & vbCrLf & _
    "Wartezeit vorher [d]: " & aplanWartezeitVorher & vbCrLf & _
    "Wartezeit nachher [d]: " & aplanWartezeitNachher

Liegt Fertigungsteil vor, sondern ein Kaufteil reicht es die Beschaffungszeit auf die Shapegröße umzurechnen und ebenfalls einzufügen.

dlz = artikelBeschaffungszeit
breite = SkaliereX(dlz)
Call ShapeEinfügen(xstart, y + shapeHöhe / 2, breite, artikelLieferant, artikelArt)

Über die Shapes von Arbeitsfolge oder Kaufteil kommt die Bezeichnung des gesamten Artikels mit der berechneten Durchlaufzeit – ebenfalls als Shape eingefügt. Hier macht auch der Alternativtext wieder Sinn.

Call ShapeEinfügen(x, y, breite, Format(dlz, "0.0") & " d: " & stücklistenArtikel & " " & artikelBezeichnung, artikelArt)
shapeNeu = Selection.Name
Selection.ShapeRange.AlternativeText = "Artikelnummer: " & stücklistenArtikel & vbCrLf & _
  "Bezeichnung: " & artikelBezeichnung & vbCrLf & _
  "DLZ [d]: " & dlz

Verbindungspfeile einfügen

Die Verbindung zwischen Stücklisten-Artikel und dessen Kind-Artikeln verbindet ein Pfeil. Dieser wird auch als Shape eingefügt, aber nur wenn es sich nicht um das Start-Produkt handelt.

If shapeName <> "" Then Call PfeilEinfügen(shapeName, shapeNeu)

Der letzte Teil des Algorithmus ruft sich selbst rekursiv wieder mit dem aktuellen Kind-Artikel auf. Auf diese Weise wird die gesamte Baumstruktur der Stückliste durchlaufen. Damit sich die Struktur nicht überschneidet, wird die y-Koordinate immer um die 2-fach Shape-Höhe vergrößert.

y = y + shapeHöhe * 2
Call ProduktstrukturBerechnen(stücklistenArtikel, menge * stücklistenMenge, x + breite, shapeNeu)

Spezielle Unterprogramme

Die Hauptroutine des Algorithmus ruft einige Unterprogramme zum Einfügen der Shapes auf. Diese schauen wir nachfolgend etwas genauer an.

Shapes gestalten und einfügen

Die Darstellung der Produktstruktur besteht nur aus vier verschiedenen Elementen. Excel-technisch werden dafür Shapes verwendet. Das hat den Vorteil, dass für Sie zum Gestalten alle Excel-Möglichkeiten vorhanden sind. Vom Farbverlauf bis zum 3D-Effekt mit Schatten ist alles möglich. Dafür gibt es auf der Tabelle Parameter Vorlagen, die Sie selber gestalten können. Jedes Shape hat auch einen Namen bekommen, über den es im VBA-Code ansprechbar ist.

Wird jetzt die Sub ShapeEinfügen aufgerufen, nutzt die Routine die festgelegte Vorlage. Zuerst muss aber das Shape an der übergebenen Koordinate mit Höhe und Breite eingefügt werden. Als weitere Parameter fordert die Routine einen Titel, aber auch den Namen der zu verwendeten Vorlage.

Sub ShapeEinfügen(xpos As Double, ypos As Double, breite As Double, titel As String, vorlage As String)
Dim shp As String
  Sheets(tabVisualisierung).Shapes.AddShape(msoShapeRectangle, xpos, ypos, breite, shapeHöhe / 2).Select
  Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = titel
  shp = Selection.Name

Mit Hilfe der Excel-Funktion Format-Übertragen / PickUp werden die grafischen Einstellungen der Vorlage auf das Shape übernommen.

  Sheets(tabParameter).Shapes("Vorlage" & vorlage).PickUp
  Sheets(tabVisualisierung).Shapes(shp).Apply
End Sub

Shapes mit Pfeilen verbinden

Auf die gleiche Weise arbeitet die Funktion, um einen Pfeil einzufügen. Der Anknüpfpunkt vom Eltern-Shape hat die Nummer 4, der des Kind-Shapes die Nummer 2.

Connector Nummern für den Verbindungspfeil zwischen den Shapes

Sub PfeilEinfügen(vonShape As String, nachShape As String)
Dim h As Double
Dim shp As String
On Error Resume Next
  ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 0, 0, 100, 100).Select
  Selection.Name = "P_" & vonShape & "_" & nachShape
  Selection.ShapeRange.ConnectorFormat.BeginConnect     Sheets(tabVisualisierung).Shapes(vonShape), 4
  Selection.ShapeRange.ConnectorFormat.EndConnect  Sheets(tabVisualisierung).Shapes(nachShape), 2

  shp = Selection.Name
  Sheets(tabParameter).Shapes("VorlagePfeil").PickUp
  Sheets(tabVisualisierung).Shapes(shp).Apply

Standardmäßig macht die Elbow Einstellung des Pfeils den Knick genau in der Mitte. Excel erlaubt aber das nachträgliche Anpassen. Dafür stellt Excel den Eigenschaften-Array Item bereit. Bei Elbow gibt es die Indizes 1, 2, 3. Der Faktor für die vertikale Verschiebung des Knicks ist in Item(2) gespeichert. Zulässige Werte sind von 0 (ganz oben) bis 1 (ganz unten). Der Standard ist 0,5.

Wir wollen, dass der Knick direkt unterhalb des ersten Shapes ist. Der Wert liegt uns bereits in der Variablen shapeHöhe vor. Um den Knick für alle Elemente an die gleiche Stelle zu bekommen, muss er anhand der Höhe berechnet werden.

  h = Sheets(tabVisualisierung).Shapes(nachShape).Top -     Sheets(tabVisualisierung).Shapes(vonShape).Top
  Selection.ShapeRange.Adjustments.Item(2) = shapeHöhe / h
  Selection.ShapeRange.Adjustments.Item(1) = 12
  Selection.ShapeRange.Adjustments.Item(3) = -12
End Sub

Die anderen Item Eigenschaften sind für die horizontale Verschiebung nach links (1) und rechts (3). Sie werden auf 12 points gesetzt.

Achsensystem

Zur Analyse der Produktstruktur fehlt aber noch ein wesentlicher Teil: ein Achsensystem.

Irgendwie muss der Zusammenhang zur Zeit erfolgen. Dafür wird eine Zeitachse eingefügt. Die Umsetzung erfolgt ebenfalls wieder über Shapes.

In Excel lassen sich auch Freiformen einfügen. Das sind Shapes mit anwenderspezifischen Punkten, die mit Linien verbunden sind. Damit lässt sich ein Raster zeichnen.

With Sheets(tabVisualisierung).Shapes.BuildFreeform(msoEditingAuto, x0, y0)
.AddNodes msoSegmentLine, msoEditingAuto, x0, y0
  For i = 1 To schritte
    dlz = dlz + step
    .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0
    .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0 - 2
    .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y - y0 + shapeHöhe
    .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0
  Next
  .ConvertToShape.Select
End With

Essentiell ist auch die Information an welchem Zeitpunkt sich die Kundenerwartung befindet. Das lässt sich gut durch eine gestrichelte rote Linie zeigen.

Sheets(tabVisualisierung).Shapes.AddConnector(msoConnectorStraight, SkaliereX(erwartungKunde), y0, SkaliereX(erwartungKunde), y - y0 + shapeHöhe).Select
  Selection.Name = "Kundenerwartung"
  With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 0, 0)
    .Transparency = 0
    .Weight = 1
    .DashStyle = msoLineDashDot
  End With

Quellcode

Hier finden Sie den gesamten Quellcode zur Übersicht.

Option Explicit

Global Const tabParameter = "Parameter"
Global Const tabStückliste = "Stückliste"
Global Const tabArtikel = "Artikel"
Global Const tabArbeitsplan = "Arbeitsplan"
Global Const tabArbeitsplatz = "Arbeitsplatz"
Global Const tabVisualisierung = "Visualisierung"

Global Const eingabeProduktArtikelnummer = "eingabeProduktArtikelnummer"
Global Const eingabeProduktMenge = "eingabeProduktmenge"
Global Const eingabeErwartungKunde = "eingabeErwartungKunde"
Global Const eingabeSkalierungX = "eingabeSkalierungX"
Global Const eingabeShapeHöhe = "eingabeShapeHöhe"
Global Const infoMeldung = "infoMeldung"


Dim produktArtikelnummer As String
Dim produktMenge As Double
Dim erwartungKunde As Double
Dim skalierungX As Double
Dim shapeHöhe As Double
Dim y As Double
Dim y0 As Double
Dim x0 As Double
Dim dlzMax As Double


'Visualisierung löschen
Sub VisualisierungLöschen()
  Sheets(tabVisualisierung).Select
  Call DeleteObjectType("P_") 'alle Pfeile
  Call DeleteObjectType("Re") 'alle Rechtecke
  Call DeleteObjectType("Te") 'alle Texte
  Call DeleteObjectType("Ku") 'Kundenerwartungslinie
  Call DeleteObjectType("Ac") 'Achsensystem
End Sub

'Löscht ein Shape nach dem Anfangsnamen
Sub DeleteObjectType(typ As String)
Dim i As Integer
Dim shp As shape

  ActiveSheet.Unprotect
  
  For Each shp In ActiveSheet.Shapes
    If Left$(shp.Name, Len(typ)) = typ Then
      shp.Delete
    End If
  Next
End Sub


'Berechnung der Visualisierung starten
'vorher wird bestehende Visualisierung gelöscht
Sub VisualisierungBerechnen()
Dim i As Integer

  Call VisualisierungLöschen

  'Einstellungen aus Tabelle Parameter einlesen
  produktArtikelnummer = Range(eingabeProduktArtikelnummer)
  produktMenge = Range(eingabeProduktMenge)
  erwartungKunde = Range(eingabeErwartungKunde)
  skalierungX = Range(eingabeSkalierungX)
  shapeHöhe = Range(eingabeShapeHöhe)
  
  
  'Startbedingungen setzen
  'Basis-Koordinaten
  x0 = 5
  y0 = Sheets(tabVisualisierung).Cells(1, 1).RowHeight
  y = y0
  
  'max. Durchlaufzeit
  dlzMax = 0
  
  'erste Stückliste berechnen und darstellen
  'die Sub ruft sich selber rekursiv wieder auf
  Call ProduktstrukturBerechnen("Produkt", produktMenge, x0, "")
  
  'Achsensystem erzeugen
  Call ErzeugeAchsensystem
  
  'Tabelle Visualsierung anzeigen
  Sheets(tabVisualisierung).Cells(1, 1).Select
End Sub


'Berechnet und visualisiert die Produktstruktur der übergebenen Artikelnummer
Sub ProduktstrukturBerechnen(artikelnummer As String, menge As Double, x As Double, shapeName As String)
Dim i As Long
Dim j As Long
Dim zeile As Long
Dim artikelBezeichnung As String
Dim artikelArt As String
Dim artikelBeschaffungszeit As Double
Dim artikelLosgröße As Integer
Dim artikelLieferant As String
Dim stücklistenArtikel As String
Dim stücklistenMenge As Double
Dim aplanFolgenummer As Integer
Dim aplanArbeitsplatz As String
Dim aplanRüstzeit As Double
Dim aplanBearbeitungszeit As Double
Dim aplanWartezeitVorher As Double
Dim aplanWartezeitNachher As Double
Dim lose As Integer
Dim breite As Double
Dim xstart As Double
Dim dlz As Double
Dim dlzafo As Double
Dim tageskapazität As Double
Dim shapeNeu As String


  xstart = x
  If x > dlzMax Then dlzMax = x

  'Tabelle Stückliste nach Artikelnummer durchsuchen
  i = 1
  Do
    i = i + 1
    If artikelnummer = Sheets(tabStückliste).Cells(i, 1) Then
      stücklistenArtikel = Sheets(tabStückliste).Cells(i, 2)
      stücklistenMenge = Sheets(tabStückliste).Cells(i, 4)
      
      'Artikeldaten abfragen
      zeile = FindeZeile(tabArtikel, 1, stücklistenArtikel)
      If zeile = -1 Then
        Call MeldungAusgeben("Warnung", "Artikel nicht gefunden: " & stücklistenArtikel)
        Exit Sub
      End If
      
      artikelBezeichnung = Sheets(tabArtikel).Cells(zeile, 2)
      'bezeichnung = WorksheetFunction.VLookup(artikelnummer, Sheets(tabArtikel).[A:E], 2, False)
      artikelArt = Sheets(tabArtikel).Cells(zeile, 3)
      artikelBeschaffungszeit = Sheets(tabArtikel).Cells(zeile, 4)
      artikelLosgröße = Sheets(tabArtikel).Cells(zeile, 5)
      artikelLieferant = Sheets(tabArtikel).Cells(zeile, 6)
      
      If artikelArt = "F" Then 'bei Fertigungsteilen
        'Arbeitsplan ermitteln
        zeile = FindeZeile(tabArbeitsplan, 1, stücklistenArtikel)
        If zeile = -1 Then
          Call MeldungAusgeben("Warnung", "Arbeitsplan nicht gefunden: " & stücklistenArtikel)
          Exit Sub
        End If
        
        'Anzahl der Lose berechnen und aufrunden auf ganze Zahl
        lose = WorksheetFunction.RoundUp(stücklistenMenge * menge / artikelLosgröße, 0)
        breite = 0
        dlz = 0
        j = zeile - 1
        Do
          j = j + 1
          
          'Arbeitsplan-Daten einlesen
          aplanFolgenummer = Sheets(tabArbeitsplan).Cells(j, 2)
          aplanArbeitsplatz = Sheets(tabArbeitsplan).Cells(j, 3)
          aplanRüstzeit = Sheets(tabArbeitsplan).Cells(j, 4)
          aplanBearbeitungszeit = Sheets(tabArbeitsplan).Cells(j, 5)
          aplanWartezeitVorher = Sheets(tabArbeitsplan).Cells(j, 6)
          aplanWartezeitNachher = Sheets(tabArbeitsplan).Cells(j, 7)
          
          'Arbeitsplätze abfragen
          zeile = FindeZeile(tabArbeitsplatz, 1, aplanArbeitsplatz)
          If zeile = -1 Then
            Call MeldungAusgeben("Warnung", "Arbeitsplatz nicht gefunden: " & aplanArbeitsplatz)
            Exit Sub
          End If
          
          'Tageskapazität einlesen
          tageskapazität = Sheets(tabArbeitsplatz).Cells(zeile, 3)
          If tageskapazität = 0 Then tageskapazität = 8
          
          'Durchlaufzeit der Arbeitsfolge berechnen
          dlzafo = aplanWartezeitVorher + (aplanRüstzeit * lose / 60 + aplanBearbeitungszeit * stücklistenMenge * menge / 60) / tageskapazität + aplanWartezeitNachher
          
          'Gesamtdurchlaufzeit berechnen
          dlz = dlz + dlzafo
          
          Call ShapeEinfügen(x, y + shapeHöhe / 2, SkaliereX(dlzafo), aplanArbeitsplatz, "Afo")
          Selection.ShapeRange.AlternativeText = "Afo " & aplanFolgenummer & vbCrLf & _
            "Arbeitsplatz: " & aplanArbeitsplatz & vbCrLf & _
            "Rüstzeit [min]: " & aplanRüstzeit & vbCrLf & _
            "Bearbeitungszeit [min]: " & aplanBearbeitungszeit & vbCrLf & _
            "Wartezeit vorher [d]: " & aplanWartezeitVorher & vbCrLf & _
            "Wartezeit nachher [d]: " & aplanWartezeitNachher

          x = x + SkaliereX(dlzafo)
        Loop Until Sheets(tabArbeitsplan).Cells(j + 1, 1) <> stücklistenArtikel
        breite = x - xstart
      Else
        'Kaufteil
        'Durchlaufzeit ist Beschaffungszeit / Wiederbeschaffungszeit
        dlz = artikelBeschaffungszeit
        breite = SkaliereX(dlz)
        
        Call ShapeEinfügen(xstart, y + shapeHöhe / 2, breite, artikelLieferant, artikelArt)
        Selection.ShapeRange.AlternativeText = ""
      End If
         
      'Titel einfügen, ist für Fertigungs- und Kaufteil gleich
      x = xstart
      Call ShapeEinfügen(x, y, breite, Format(dlz, "0.0") & " d: " & stücklistenArtikel & " " & artikelBezeichnung, artikelArt)
      shapeNeu = Selection.Name
      Selection.ShapeRange.AlternativeText = "Artikelnummer: " & stücklistenArtikel & vbCrLf & _
        "Bezeichnung: " & artikelBezeichnung & vbCrLf & _
        "DLZ [d]: " & dlz
      If shapeName <> "" Then Call PfeilEinfügen(shapeName, shapeNeu)
      
      'Stückliste rekursiv durchlaufen
      y = y + shapeHöhe * 2
      Call ProduktstrukturBerechnen(stücklistenArtikel, menge * stücklistenMenge, x + breite, shapeNeu)
    End If
     
  Loop Until Sheets(tabStückliste).Cells(i + 1, 1) = ""
End Sub


'Die Sub fügt ein Shape an der übergebenen xpos und ypos ein
'Die vorlage bezeichnet das Vorlagen-Shape aus der Parameter-Tabelle
Sub ShapeEinfügen(xpos As Double, ypos As Double, breite As Double, titel As String, vorlage As String)
Dim shp As String
  
    Sheets(tabVisualisierung).Shapes.AddShape(msoShapeRectangle, xpos, ypos, breite, shapeHöhe / 2).Select
    'Selection.Name = "R_" & titel
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = titel
    shp = Selection.Name
    
    'Formatierung aus der Vorlage übernehmen
    Sheets(tabParameter).Shapes("Vorlage" & vorlage).PickUp
    Sheets(tabVisualisierung).Shapes(shp).Apply
End Sub

Sub PfeilEinfügen(vonShape As String, nachShape As String)
Dim h As Double
Dim shp As String

'hier kommt es manchmal zu ungewollten Fehlern, wenn Excel den Connector msoConnectorElbow nicht annimmt
'deswegen Error Resume Next
On Error Resume Next

  ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 0, 0, 100, 100).Select
  Selection.Name = "P_" & vonShape & "_" & nachShape
  'Selection.ShapeRange.AlternativeText = ""
  Selection.ShapeRange.ConnectorFormat.BeginConnect Sheets(tabVisualisierung).Shapes(vonShape), 4
  Selection.ShapeRange.ConnectorFormat.EndConnect Sheets(tabVisualisierung).Shapes(nachShape), 2

  'Formatierung aus der Vorlage übernehmen
  shp = Selection.Name
  Sheets(tabParameter).Shapes("VorlagePfeil").PickUp
  Sheets(tabVisualisierung).Shapes(shp).Apply
    
  'Elbow nimmt standardmäßig immer die Mitte für den Knick ein
  'wir wollen, dass dieser immer oben ist, deswegen müssen wir ihn jeweils auf die shapeHöhe umrechnen
  h = Sheets(tabVisualisierung).Shapes(nachShape).Top - Sheets(tabVisualisierung).Shapes(vonShape).Top
  Selection.ShapeRange.Adjustments.Item(2) = shapeHöhe / h
  
  'die anderen Items sind für die horizontale Verschiebung nach links und rechts 12 points
  Selection.ShapeRange.Adjustments.Item(1) = 12
  Selection.ShapeRange.Adjustments.Item(3) = -12
End Sub

'Fügt eine Textbox an der xpos und ypos ein, mit Breite w und Höhe h
Sub TextboxEinfügen(xpos As Double, ypos As Double, w As Double, h As Double, titel As String)
    Sheets(tabVisualisierung).Shapes.AddTextbox(msoTextOrientationHorizontal, xpos, ypos, w, h).Select
    Selection.ShapeRange.ScaleHeight 1.75, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = titel
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.ParagraphFormat.FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 9
        .Name = "+mn-lt"
    End With
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.Fill.Visible = msoFalse
End Sub

'Umrechnung von Durchlaufzeit-Tagen in points
Function SkaliereX(wert As Double) As Double
Dim result As Double

  result = wert * skalierungX
  SkaliereX = result
End Function


'Sucht in einer Tabelle eine Spalte nach einem Wert und liefert als Ergebnis die Zeilennummer
Function FindeZeile(tabelle As String, spalte As Long, wert As String) As Long
Dim result As Long
Dim i As Long

  result = -1
  i = 1
  Do
    i = i + 1
    If Sheets(tabelle).Cells(i, spalte) = wert Then result = i
  Loop Until Sheets(tabelle).Cells(i + 1, spalte) = "" Or result <> -1
  
  FindeZeile = result
End Function


'Zeichnet ein einfaches Achsensystem für die Durchlaufzeit
Sub ErzeugeAchsensystem()
Dim i As Integer
Dim step As Double
Dim dlz As Double

Const schritte = 10

  '
  step = WorksheetFunction.RoundUp((dlzMax / skalierungX) / schritte, 0)
  dlz = 0
  
  'Achsen und Hilfsachsen zeichnen
  With Sheets(tabVisualisierung).Shapes.BuildFreeform(msoEditingAuto, x0, y0)
    .AddNodes msoSegmentLine, msoEditingAuto, x0, y0
    For i = 1 To schritte
      dlz = dlz + step
        
      .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0
      .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0 - 2
      .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y - y0 + shapeHöhe
      .AddNodes msoSegmentLine, msoEditingAuto, SkaliereX(dlz), y0
    Next
    .ConvertToShape.Select
  End With
    
  With Selection.ShapeRange.Line
      .ForeColor.RGB = RGB(20, 20, 20)
      .Transparency = 0.5
      .Weight = 1
  End With
  Selection.Name = "Achsensystem"
  
  'Beschriftungen einfügen
  dlz = 0
  For i = 1 To schritte
    dlz = dlz + step
    Call TextboxEinfügen(x0 + SkaliereX(dlz) - 20, y0 - 18, 40, 15, CStr(dlz) & " d")
  Next
  
  'Linie der Kundenerwartung einzeichnen
  Sheets(tabVisualisierung).Shapes.AddConnector(msoConnectorStraight, SkaliereX(erwartungKunde), y0, SkaliereX(erwartungKunde), y - y0 + shapeHöhe).Select
  Selection.Name = "Kundenerwartung"
  With Selection.ShapeRange.Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Weight = 1
      .DashStyle = msoLineDashDot
  End With
  Call TextboxEinfügen(x0 + SkaliereX(erwartungKunde) - 5, y0 + 2, 60, 20, "Erwartung Kunde")
  With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Solid
  End With
  Selection.ShapeRange.TextFrame2.TextRange.Font.Name = "Segoe UI"
  Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 10
End Sub

'Gibt einen Text auf der Tabelle Parameter aus
Sub MeldungAusgeben(art As String, meldung As String)
  Range(infoMeldung) = meldung
  If art = "Warnung" Then
    Range(infoMeldung).Cells.Interior.Color = RGB(255, 50, 50)
  Else
    Range(infoMeldung).Cells.Interior.Color = RGB(255, 255, 255)
  End If
End Sub