Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If ContentControl.Tag = "LayoutAuswahl" Then
BildEinfuegen
End If
If ContentControl.Tag = "AusgabeZustand" Then
Farbausgabe
End If
End Sub
Sub BildEinfuegen()
Dim i As Integer
Dim treffer As Boolean
Dim meineTabelle As Table
Dim pfad As String, Prefix As String
With ActiveDocument
For i = 1 To .Tables.Count
If .Tables(i).Title = "Pack Design" Then
Set meineTabelle = .Tables(i)
treffer = True
Exit For
End If
Next i
End With
If treffer = False Then
MsgBox "Keine Tabelle mit dem Titel 'Pack Design' gefunden! Wenn gewünscht bitte einer Tabelle unter Tabelleneigenschaften-Alternativtext unter 'Titel' den Namen 'Pack Design' zuweisen"
Exit Sub
End If
If treffer = True Then
On Error GoTo fehler
Prefix = ActiveDocument.SelectContentControlsByTag("LayoutAuswahl").Item(1).Range.Text
pfad = "C:\Users\c.seidl\Desktop\Bilder_Batterien\"
meineTabelle.Rows(1).Cells(1).Range.InlineShapes.AddPicture FileName:=pfad & Prefix & "_1.png"
End If
Exit Sub
fehler:
MsgBox "Kein passendes Bild vorhanden"
End Sub
Sub Farbausgabe()
Dim zustand As String
With ActiveDocument.SelectContentControlsByTag("AusgabeZustand").Item(1)
zustand = .Range.Text
Select Case zustand
Case "n.d.": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
Case "PASS": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
Case "OK": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
Case "FAIL": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Case "NOK": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
Case "undetermined": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
Case "n.r.": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGrey
End Select
End With
End Sub