none
Publisher 2003: Makro zum Ändern von Text in Tabellen RRS feed

  • Frage

  • Guten Tag,

    ist es möglich Tabellen zu benennen, so daß ein Makro auf eine benannte Tabelle zugreifen kann, um den Text in den Zellen der Tabelle zu ändern. Das Makro soll bis auf dieTitelzeile(n) alle Einträge eine Zeile nach oben verschieben, wobei die Werte in der obersten Zeile wegfallen. Die letzte Zeile der Tabelle soll vom Makro mit neuen Werten gefüllt werden. Die neuen Werte sollen dabei in einem Formular eingegeben werden. Das Formular soll das Makro zur Fortführung der Tabelle im Publisher-Dokument nach Abschluß und Prüfung der eingegebenen Werte aufrufen. Optimal wäre dabei ein Klassenmodul, das für alle zu ändernden Spalten ein Eingabefeld erzeugt. Anzahl und Namen der einzugebenden Felder sowie die Art der Prüfung für jedes Feld (z.b: Text, Zahl, Währung) sollten dabei beim Aufruf des Klassenmoduls übergeben werden.

     

    Grüße

    Little Hobbit

    Dienstag, 13. März 2012 08:40

Antworten

  • Problem gelöst:

    Voraussetzung: Shape mit der Tabelle liegt als Shape-Objekt vor.

    Zu unterscheiden sind das Lesen einer Spalte bzw. einer Zeile. Da in der Tabelle

    Spalten oder Zeilen verbunden sein können, muß vor jedem Zugriff auf eine Zelle

    ihre Existenz überprüft werden.

    Die gelesenen Werte werden von der Fuktion als Array zurückgegeben. Die Werte können dann

    in einer Userform dargestellt, geändert und an die Tabelle im Publisher-Dokument wieder übergeben werden.

    'VBA_Code
    
    '----------------------------------------------------------------------------------------------------------
    'Function ArrayLesen
    'Autor:             Little Hobbit
    'Datum:             10.05.2012
    'Copyright          (c) 2012 Little Hobbit
    '
    'Mit der Funktion werden die Werte in einer Tabellenzeile oder in einer Tabellenspalte
    'gelesen.
    '
    'Globale Variable   m_shape, Shape mit der Tabelle
    '                   bolZeileLesen, Vorbelegung für das Lesen einer Zeile oder Spalte
    '                   m_Zeile, m_Spalte Zeilen- bzw. Spaltennumer der zu lesenden Daten
    '
    'Variable:          keine
    '
    'Rückgabewert:      Array mit den gelesenen Werten
    '
    'Hilfsfunktionen:   IsRowValid und IsColumnValid, Existenztest für Zellen
    '----------------------------------------------------------------------------------------------------------
    
    Private Function ArrayLesen() As Boolean
        On Error GoTo Err_Sub
        
        Const SUBNAME       As String = "ArrayLesen"
    
        Dim intCountRow     As Integer
        Dim intCountColumn  As Integer
        Dim dblArray()      As Double
        Dim i               As Integer
        Dim j               As Integer
        Dim varTest         As Variant
        Dim strError        As String
        Dim strMeldung      As String
        Dim intAnswer       As Integer
        Dim intSpalte       As Integer
        Dim intZeile        As Integer
        
        intCountRow = m_Shape.Table.Rows.Count         'Zeilenanzahl
        intCountColumn = m_Shape.Table.Columns.Count   'Spaltenanzahl
        j = 0
        On Error GoTo Exit_Sub
        
        Select Case bolZeileLesen
            Case True
                'intZeile = Zeile_ermitteln
                intZeile = m_Zeile
                'Zeile lesen
                For i = m_Spalte To intCountColumn
                    
                    If IsRowValid(i, intZeile) Then
                        varTest = m_Shape.Table.Rows(intZeile).Cells(i).TextRange.Text
                        
                        If IsNumeric(varTest) Then      'Zelle ohne Zahlenwert ausschließen
                            j = j + 1
                            ReDim Preserve m_Array(j)
                            m_Array(j) = CDbl(varTest)
                        End If
                        
                    Else
                        i = intCountColumn
                    End If
                    
                Next i
                
            Case Else
                'Spalte lesen
                
                'intSpalte = Spalte_ermitteln
                intSpalte = m_Spalte
                For i = m_Zeile To intCountRow
                    
                    If IsColumnValid(i, intSpalte) Then
                        varTest = m_Shape.Table.Columns(intSpalte).Cells(i).TextRange.Text
                        
                        If IsNumeric(varTest) Then      'Zelle ohne Zahlenwert ausschließen
                            j = j + 1
                            ReDim Preserve m_Array(j)
                            m_Array(j) = CDbl(varTest)
                        End If
                        
                    Else
                        i = intCountRow
                    End If
                    
                Next i
                
        End Select
        
        If j > 0 Then ArrayLesen = True
        
    Exit_Sub:
        Exit Function
        
    Err_Sub:
        strError = "Routine:" & SUBNAME & "." & clsName & vbCrLf
    
        Select Case Err.Number
        
            Case 9
                strMeldung = "Die Tabelle wurde nicht gefunden."
            Case Else 'Ausgabe sonstiger Fehler
                strMeldung = "Fehlernummer:  " & Err.Number & _
                            vbCrLf & Err.Description
        End Select
        
        strMeldung = strError & strMeldung
        intAnswer = MsgBox(strMeldung, vbDefaultButton1, "Fehlermeldung")
        Resume Exit_Sub
    
    End Function
    
    Private Function IsRowValid(ByVal intRow As Integer, ByVal intColumn As Integer) As Boolean
        On Error GoTo Err_IsRowValid
        Dim varTest         As Variant
        
        
        IsRowValid = False
        varTest = m_Shape.Table.Rows(intColumn).Cells(intRow).TextRange.Text
        IsRowValid = True
    
    Exit_IsRowValid:
        Exit Function
    Err_IsRowValid:
        Resume Exit_IsRowValid
    End Function
    
    Private Function IsColumnValid(ByVal intColumn As Integer, ByVal intRow As Integer) As Boolean
        On Error GoTo Err_IsColumnValid
        Dim varTest         As Variant
        
        IsColumnValid = False
        varTest = m_Shape.Table.Columns(intRow).Cells(intColumn).TextRange.Text
        IsColumnValid = True
    
    Exit_IsColumnValid:
        Exit Function
    Err_IsColumnValid:
        Resume Exit_IsColumnValid
    End Function
    

    • Als Antwort markiert Little Hobbit Donnerstag, 10. Mai 2012 14:43
    Donnerstag, 10. Mai 2012 14:39