Es gibt F\u00e4lle, in denen in Worddokumenten der Zellenhintergrund in Tabellen abh\u00e4ngig vom Text der Tabellenzelle gesetzt werden muss. Wenn das im ganzen Dokument nach dem gleichen Regelwerk erfolgen soll, kann ein Makro die Arbeit deutlich vereinfachen.<\/p>\n
Das folgende Makro habe ich daher auf Nachfrage eines Blogbesuchers erstellt. Das Makro durchsucht alle Tabellen im ge\u00f6ffneten Dokument nach zwei vorgegebenen Zeichenketten (case-sensitiv!), die \u00fcber die beiden Variablen strString1<\/em> und strString2<\/em> definiert sind. Aktuell sind die Zeichenketten „orange“ und „rot“ eingestellt.<\/p>\n Die Zellenhintergrundfarben werden \u00fcber die beiden Variablen lFarbe1<\/em> und lFarbe2<\/em> definiert.<\/p>\n lFarbe1<\/em> definiert dabei die Farbe f\u00fcr die Zeichenkette strString1<\/em>, lFarbe2<\/em> f\u00fcr strString2<\/em>.<\/p>\n Und hier noch eine erweiterte Version, falls nicht nur f\u00fcr die Zelle mit der gesuchten Zeichenkette selbst, sondern auch f\u00fcr die linke Nachbarzelle (sofern vorhanden) der Zellenhintergrund gesetzt werden soll.<\/p>\n Beschreibung Es gibt F\u00e4lle, in denen in Worddokumenten der Zellenhintergrund in Tabellen abh\u00e4ngig vom Text der Tabellenzelle gesetzt werden muss. Wenn das im ganzen Dokument nach dem gleichen Regelwerk erfolgen soll, kann ein Makro die Arbeit deutlich vereinfachen.<\/p>\n","protected":false},"author":3,"featured_media":0,"comment_status":"closed","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"ngg_post_thumbnail":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":""},"categories":[29,19],"tags":[],"class_list":["post-2067","post","type-post","status-publish","format-standard","hentry","category-startseite","category-vba-word"],"jetpack_featured_media_url":"","jetpack_shortlink":"https:\/\/wp.me\/p5LyzC-xl","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/posts\/2067","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/users\/3"}],"replies":[{"embeddable":true,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=2067"}],"version-history":[{"count":5,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/posts\/2067\/revisions"}],"predecessor-version":[{"id":2376,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=\/wp\/v2\/posts\/2067\/revisions\/2376"}],"wp:attachment":[{"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=2067"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=2067"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.kastenmaier.de\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=2067"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}strString1 = "orange"\r\nstrString2 = "rot"<\/pre>\n
lFarbe1 = 49407 ' orange\r\nlFarbe2 = wdColorRed ' rot<\/pre>\n
Sourcecode<\/h1>\n
Public Sub ZellenhintergrundFaerben()\r\n ' Definition der Zelleninhalte f\u00fcr die Hintergrundfarben\r\n Dim strString1 As String\r\n Dim strString2 As String\r\n \r\n strString1 = "orange"\r\n strString2 = "rot"\r\n \r\n ' Definition der Zelleninhalte f\u00fcr die Hintergrundfarben\r\n Dim lFarbe1 As Long\r\n Dim lFarbe2 As Long\r\n \r\n lFarbe1 = 49407 ' orange\r\n lFarbe2 = wdColorRed ' rot\r\n\r\n\r\n On Error GoTo NoDocumentOpen\r\n If Len(ActiveDocument.Name) = 0 Then GoTo NoDocumentOpen\r\n \r\n Dim oCurTable As Table\r\n Dim strCurCellText As String\r\n \r\n For Each oCurTable In ActiveDocument.Tables\r\n Dim oCurRow As Row\r\n \r\n With oCurTable\r\n For Each oCurRow In .Rows\r\n Dim oCurCell As Cell\r\n\r\n For Each oCurCell In oCurRow.Cells\r\n \r\n ' Bildschirmaktualisierung abschalten\r\n Application.ScreenUpdating = False\r\n \r\n ' Zelleinhalt ermitteln und ggfs. um 2 Stellen k\u00fcrzen\r\n strCurCellText = oCurCell.Range\r\n \r\n If Len(strCurCellText) >= 2 Then\r\n strCurCellText = Left(strCurCellText, Len(strCurCellText) - 2)\r\n End If\r\n \r\n ' Zellenhintergrundfarbe setzen\r\n If StrComp(strCurCellText, strString1) = 0 Then\r\n oCurCell.Shading.BackgroundPatternColor = lFarbe1\r\n ElseIf StrComp(strCurCellText, strString2) = 0 Then\r\n oCurCell.Shading.BackgroundPatternColor = lFarbe2\r\n End If\r\n \r\n Next oCurCell\r\n Next oCurRow\r\n End With\r\n Next oCurTable\r\n\r\nNoDocumentOpen:\r\n ' Bildschirmaktualisierung einschalten\r\n Application.ScreenUpdating = True\r\nEnd Sub<\/pre>\n
Sourcecode (auch den Zellenhintergrund\u00a0der linken Nachbarzelle setzen)<\/h1>\n
Public Sub ZellenhintergrundFaerben()\r\n ' Definition der Zelleninhalte f\u00fcr die Hintergrundfarben\r\n Dim strString1 As String\r\n Dim strString2 As String\r\n \r\n strString1 = "orange"\r\n strString2 = "rot"\r\n \r\n ' Definition der Zelleninhalte f\u00fcr die Hintergrundfarben\r\n Dim lFarbe1 As Long\r\n Dim lFarbe2 As Long\r\n \r\n lFarbe1 = 49407 ' orange\r\n lFarbe2 = wdColorRed ' rot\r\n\r\n\r\n On Error GoTo NoDocumentOpen\r\n If Len(ActiveDocument.Name) = 0 Then GoTo NoDocumentOpen\r\n \r\n Dim oCurTable As Table\r\n Dim strCurCellText As String\r\n \r\n For Each oCurTable In ActiveDocument.Tables\r\n Dim oCurRow As Row\r\n \r\n With oCurTable\r\n For Each oCurRow In .Rows\r\n Dim oCurCell As Cell\r\n\r\n For Each oCurCell In oCurRow.Cells\r\n \r\n ' Bildschirmaktualisierung abschalten\r\n Application.ScreenUpdating = False\r\n \r\n ' Zelleinhalt ermitteln und ggfs. um 2 Stellen k\u00fcrzen\r\n strCurCellText = oCurCell.Range\r\n \r\n If Len(strCurCellText) >= 2 Then\r\n strCurCellText = Left(strCurCellText, Len(strCurCellText) - 2)\r\n End If\r\n \r\n If StrComp(strCurCellText, strString1) = 0 Then\r\n ' Zellenhintergrundfarbe setzen\r\n oCurCell.Shading.BackgroundPatternColor = lFarbe1\r\n ' Zellenhintergrundfarbe der linken Nachbarzelle (sofern vorhanden) setzen\r\n If oCurCell.ColumnIndex >= 1 Then\r\n oCurTable.Cell(oCurRow.Index, oCurCell.ColumnIndex - 1).Shading.BackgroundPatternColor = lFarbe1\r\n End If\r\n ElseIf StrComp(strCurCellText, strString2) = 0 Then\r\n ' Zellenhintergrundfarbe setzen\r\n oCurCell.Shading.BackgroundPatternColor = lFarbe2\r\n ' Zellenhintergrundfarbe der linken Nachbarzelle (sofern vorhanden) setzen\r\n If oCurCell.ColumnIndex >= 1 Then\r\n oCurTable.Cell(oCurRow.Index, oCurCell.ColumnIndex - 1).Shading.BackgroundPatternColor = lFarbe2\r\n End If\r\n End If\r\n \r\n Next oCurCell\r\n Next oCurRow\r\n End With\r\n Next oCurTable\r\n\r\nNoDocumentOpen:\r\n ' Bildschirmaktualisierung einschalten\r\n Application.ScreenUpdating = True\r\nEnd Sub<\/pre>\n","protected":false},"excerpt":{"rendered":"