none
Publisher 2003: Makro zum Ändern der Backcolor in Tabellen RRS feed

  • Frage

  • Guten Tag,

     

    mit dem nachfolgenden Code soll in einem Publisher-Dokument die Änderung der Backcolor in ca. 50 Tabellen geändert werden. Die Änderung soll in Abhängigkeit von der existierenden Backcolor der jeweiligen Zelle erfolgen.

    Der unten stehende Code erzeugt den Fehler 70. Der Fehler wird duch den Abruf der Backcolor in der If - Abfrage verursacht. Laut VBA-Hilfe kann die Backcolor - Eigenschaft zum Zurückgeben der Backcolor benutzt werden.

    Ähnliche Aufrufe zum Abfragen der Backcolor wie:

    lgColorCyan = Selection.ChildShapeRange.Fill.BackColor.CMYK.Cyan

    oder

    lgColorCyan = ActiveDocument.Pages(lgIndex).Shapes(1).Table.Rows(1).Cells(1).Fill.BackColor.CMYK.Cyan

    verursachen den gleichen Fehler.

    Wie ist Aufgabe zu lösen?

    Grüße

    Little Hobbit

     

    Sub TableCellColor()

        On Error GoTo Fehler
        Dim pgsPage As Page
        Dim shpShape As Shape
        Dim myTable As Table
        Dim intCountRow As Integer
        Dim intCountColumn As Integer
        Dim i As Integer
        Dim j As Integer
       
        For Each pgsPage In ActiveDocument.Pages
            For Each shpShape In pgsPage.Shapes
                If shpShape.Type = pbTable Then
                    intCountRow = shpShape.Table.Rows.Count
                    intCountColumn = shpShape.Table.Columns.Count
                   
                For i = 1 To intCountRow
                    For j = 1 To intCountColumn
                        If shpShape.Table.Rows(i).Cells(j).Fill.BackColor.CMYK.Magenta = 5 Then
                            shpShape.Table.Rows(i).Cells(j).Fill.BackColor.CMYK.Magenta = 66
                        End If
                    Next j
                Next i
                       
               
                End If
            Next shpShape
        Next pgsPage

    Exit Sub

    Fehler:
    MsgBox Err.Number & " " & Err.Description
    End Sub
    Dienstag, 13. März 2012 08:35

Antworten

  • ....
    Mittwoch, 9. Mai 2012 16:17
  • Problem gelöst:

    1. Tabellen im Publiher-Dokument suchen.

    'VBA-Code:

    'Sub SucheTabelle

                               


    'Autor:             Little Hobbit
    'Datum:             10.05.2012
    'Copyright          (c) 2012 Little Hobbit
    '
    'Mit der Funktion werden alle Tabellen in einem Publisher-Dokument gesucht
    '
    'Variable:          keine
    '
    'Rückgabewert:      keiner
    '----------------------------------------------------------------------------------------------------------
    Private Function SucheTabelle()     Dim myPage              As Page
        Dim shpShape            As Shape
        Dim shpTemp             As Shape

        For Each myPage In ActiveDocument.Pages

            For Each shpShape In myPage.Shapes
                If shpShape.Type= pbTable Then
    Call SetzeTabellenfarbe(shpShape)

                ElseIf shpShape.Type = pbGroup Then

                    Set shpTemp = ShapeInGroup(shpShape, NameShape)

                    If Not shpTemp Is Nothing Then

    Call SetzeTabellenfarbe(shpTemp)

                    End If

                End If

            Next shpShape

        Next myPage
    Exit_Function: Exit Function End Function

    Private Function TableInGroup(shpShape As Shape) As Shape

        Dim shpTest             As Shape
        Dim shpTemp             As Shape
        Dim intAnzahlItems      As Integer
        Dim i                   As Integer
        
        intAnzahlItems = shpShape.GroupItems.Count
        
        For i = 1 To intAnzahlItems
            Set shpTest = shpShape.GroupItems.Item(i)
                        
            If shpTest.Type = pbTable Then
                Set TableInGroup = shpTest
                GoTo Exit_Function
            ElseIf shpTest.Type = pbGroup Then
                If Not TableInGroup(shpTest) Is Nothing Then GoTo Exit_Function
            End If
                        
        Next i
            
    Exit_Function:
        Exit Function
    End Function


    2. Farbe ändern

    'VBA-Code: '---------------------------------------------------------------------------------------------------------- 'Sub SetzeTabellenfarbe 'Autor: Little Hobbit 'Datum: 10.05.2012 'Copyright (c) 2012 Little Hobbit ' 'Mit der Funktion werden alle Zellen einer Tabelle,

    'die eine CMYK-Farbe besitzen, mit der global gesetzten CMYK-Farbe coloriert. ' 'Globale Variable m_ColorTabelle mit CMYK - Farbwerten 'Variable: myShape (Shape mit der Tabelle,deren Zeilen coloriert werden sollen) ' 'Rückgabewert: keiner '---------------------------------------------------------------------------------------------------------- Private Sub SetzeTabellenfarbe(ByVal myShape As Shape) On Error GoTo Err_Sub Dim celTable As Cell If Not myShape.Type = pbTable Then GoTo Exit_Sub For Each celTable In myShape.Table.Cells With celTable.Fill.ForeColor.CMYK If (.Yellow > 0 Or .Cyan > 0 _ Or .Magenta > 0 Or .Black > 0) Then .SetCMYK _ Cyan:=m_ColorTabelle.Cyan, _ Magenta:=m_ColorTabelle.Magenta, _ Yellow:=m_ColorTabelle.Yellow, _ Black:=m_ColorTabelle.Black End If End With Next celTable Exit_Sub: Exit Sub Err_Sub: Select Case Err.Number Case 70 'Celle ohne CYMK-Farbe Resume Next End Select End Sub









    Donnerstag, 10. Mai 2012 09:49

Alle Antworten

  • Hallo,

    ich habe das Problem lokal nachgestellt und bin auf den gleichen Fehler gestoßen wie Sie.

    Folgende Dinge sind mir aufgefallen:

    Anstatt der BackColor sollten Sie die ForeColor ändern, die BackColor zu ändern hat bei mir keinen sichtbaren Unterschied gemacht.

    Dieser Code funktioniert ohne Probleme

    If shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.RGB = RGB(1,2,3) Then
    	shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.RGB = RGB(4,5,6)
    End If 

    Und sobal man einmal im CMYK-Farbraum die ForeColor gesetzt hat funktioniert auch ihr Code wieder.

    If shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.CMYK.Magenta = 5 Then
    	shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.Magenta = 100
    End If 

    Das heißt, wenn die ForeColor im RGB-Raum gesetzt wurde (also standardmäßig) können Sie den CMYK-Wert davon nicht abfragen. Sobal dieser aber einaml gesetzt wurde, können Sie ihn abfragen und daraufhin neu einfärben.


    Viele Grüße,
    Thomas Fröhle
    MSDN Hotline für MSDN Online Deutschland


    Disclaimer:
    Bitte haben Sie Verständnis dafür, dass wir hier auf Rückfragen gar nicht oder nur sehr zeitverzögert antworten können. Bitte nutzen Sie für Rückfragen oder neue Fragen den telefonischen Weg über die MSDN Hotline: http://www.msdn-online.de/Hotline
    MSDN Hotline: Schnelle & kompetente Hilfe für Entwickler: kostenfrei!

    Es gelten für die MSDN Hotline und dieses Posting diese Nutzungsbedingungen, Hinweise zu MarkenzeichenInformationen zur Datensicherheit sowie die gesonderten Nutzungsbedingungen für die MSDN Hotline.



    Freitag, 16. März 2012 13:02
  • Vielen Dank Herr Fröhle!

    Das Setzen und Abfragen der ForeColor funktioniert. Doch wie setze ich in einem Publischer-Dokument die ForeColor?

    Wenn ich im Publisher-Dokument die Zelle einer Tabelle mit einer Farbe fülle, kann ich nach wie vor diesen Farbwert nicht per VBA abfragen.

    Der folgende Code:

    If shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.CMYK.Magenta = 5 Then
    
    shpShape.Table.Rows(i).Cells(j).Fill.ForeColor.Magenta = 100
    
    End If

    meldet wie gehabt den Fehler 70.

    Die Abfrage der ForeColor funktioniert nur, wenn dieser Wert auch per VBA gesetzt wurde. Werden in der Schleife Zellen abgefragt, denen keine ForeColor per VBA zugewiesen wurde (z.B. Zellen ohne Füllung), so tritt gleichfalls der Fehler 70 auf.

    Mit freundlichem Gruß

    Little Hobbit

    Montag, 19. März 2012 13:37
  • ....
    Mittwoch, 9. Mai 2012 16:17
  • Problem gelöst:

    1. Tabellen im Publiher-Dokument suchen.

    'VBA-Code:

    'Sub SucheTabelle

                               


    'Autor:             Little Hobbit
    'Datum:             10.05.2012
    'Copyright          (c) 2012 Little Hobbit
    '
    'Mit der Funktion werden alle Tabellen in einem Publisher-Dokument gesucht
    '
    'Variable:          keine
    '
    'Rückgabewert:      keiner
    '----------------------------------------------------------------------------------------------------------
    Private Function SucheTabelle()     Dim myPage              As Page
        Dim shpShape            As Shape
        Dim shpTemp             As Shape

        For Each myPage In ActiveDocument.Pages

            For Each shpShape In myPage.Shapes
                If shpShape.Type= pbTable Then
    Call SetzeTabellenfarbe(shpShape)

                ElseIf shpShape.Type = pbGroup Then

                    Set shpTemp = ShapeInGroup(shpShape, NameShape)

                    If Not shpTemp Is Nothing Then

    Call SetzeTabellenfarbe(shpTemp)

                    End If

                End If

            Next shpShape

        Next myPage
    Exit_Function: Exit Function End Function

    Private Function TableInGroup(shpShape As Shape) As Shape

        Dim shpTest             As Shape
        Dim shpTemp             As Shape
        Dim intAnzahlItems      As Integer
        Dim i                   As Integer
        
        intAnzahlItems = shpShape.GroupItems.Count
        
        For i = 1 To intAnzahlItems
            Set shpTest = shpShape.GroupItems.Item(i)
                        
            If shpTest.Type = pbTable Then
                Set TableInGroup = shpTest
                GoTo Exit_Function
            ElseIf shpTest.Type = pbGroup Then
                If Not TableInGroup(shpTest) Is Nothing Then GoTo Exit_Function
            End If
                        
        Next i
            
    Exit_Function:
        Exit Function
    End Function


    2. Farbe ändern

    'VBA-Code: '---------------------------------------------------------------------------------------------------------- 'Sub SetzeTabellenfarbe 'Autor: Little Hobbit 'Datum: 10.05.2012 'Copyright (c) 2012 Little Hobbit ' 'Mit der Funktion werden alle Zellen einer Tabelle,

    'die eine CMYK-Farbe besitzen, mit der global gesetzten CMYK-Farbe coloriert. ' 'Globale Variable m_ColorTabelle mit CMYK - Farbwerten 'Variable: myShape (Shape mit der Tabelle,deren Zeilen coloriert werden sollen) ' 'Rückgabewert: keiner '---------------------------------------------------------------------------------------------------------- Private Sub SetzeTabellenfarbe(ByVal myShape As Shape) On Error GoTo Err_Sub Dim celTable As Cell If Not myShape.Type = pbTable Then GoTo Exit_Sub For Each celTable In myShape.Table.Cells With celTable.Fill.ForeColor.CMYK If (.Yellow > 0 Or .Cyan > 0 _ Or .Magenta > 0 Or .Black > 0) Then .SetCMYK _ Cyan:=m_ColorTabelle.Cyan, _ Magenta:=m_ColorTabelle.Magenta, _ Yellow:=m_ColorTabelle.Yellow, _ Black:=m_ColorTabelle.Black End If End With Next celTable Exit_Sub: Exit Sub Err_Sub: Select Case Err.Number Case 70 'Celle ohne CYMK-Farbe Resume Next End Select End Sub









    Donnerstag, 10. Mai 2012 09:49