Werte Community,

ich habe bei einem Code noch ein kleines Problem. Zur Beschreibung: "BildEinfuegen" funktioniert soweit, jedoch gibt es bei "Farbausgabe" ein Problem: in meinem Word sind in einer Spalte einer Tabellen Inhaltssteuerelemente mit den Auswahlmöglichkeiten PASS, FAIL, notDone abgelegt. Diese sollen sich nach Auswählen eines Status verfärben (PASS = grün, FAIL = rot, notDone = gelb).

Mein erstes Inhaltssteuerelement in dieser Tabelle funktioniert auch einwandfrei, die nachfolgenden werden jedoch anscheinend nicht mehr angesprochen! Hat jemand eine Idee warum das so ist und wie ich dies lösen kann?

 

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