Clever-Excel-Forum

Normale Version: Jeder zweiter Aufruf bringt einen Fehler
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Ha((o

Habe folgenden Fehler. Jeden zweiten Aufruf erhalten ich immer an der gleichen Stelle eine Fehlermeldung. Dies ist mein Code:

Code:
Sub Tabelle_Generieren(ByRef wddoc As Word.Document, ByRef z1 As Integer)

Dim zeile As Integer
Dim spalte As Integer
Dim maxspalte As Integer
Dim excelspalte As Integer
Dim z2 As Integer
Dim rabatt As Boolean
Dim ueberschrift
Dim excelueberschrift
Dim wdtab As Object

   ueberschrift = Array("Pos", "Art.Nr", "Produkt", "Mg", "Einh", "Preis/E", "Rabatt", "Gesamt")
   excelueberschrift = Array("Pos.", "Art.Nr. SALVAL", "Bezeichnung", "Menge", "Menge2", "UVP Brutto", "Rabatt", "Brutto")

   Call Rechnungsbereich_Festlegen(z1, z2, rabatt)
   
   If rabatt = True Then
       Set wdtab = wddoc.Tables.Add(Range:=wddoc.Bookmarks("Tabelle").Range, NumRows:=z2 - z1 + 1, NumColumns:=8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
       With wdtab
           .Borders.Enable = False
           .Columns(1).PreferredWidth = CentimetersToPoints(0.9) 'Position
           .Columns(2).PreferredWidth = CentimetersToPoints(2)   'Art.Nr.
           .Columns(3).PreferredWidth = CentimetersToPoints(6.5) 'Bezeichnung
           .Columns(4).PreferredWidth = CentimetersToPoints(0.8) 'Menge
           .Columns(5).PreferredWidth = CentimetersToPoints(1.2) 'Einheit
           .Columns(6).PreferredWidth = CentimetersToPoints(2)   'Originalpreis
           .Columns(7).PreferredWidth = CentimetersToPoints(1.6) 'Rabatt
           .Columns(8).PreferredWidth = CentimetersToPoints(2)   'Gesamtpreis
       End With
       wdtab.Columns(8).Select
       'Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
       maxspalte = 8

   Else
       Set wdtab = wddoc.Tables.Add(Range:=wddoc.Bookmarks("Tabelle").Range, NumRows:=z2 - z1 + 1, NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
       With wdtab
           .Borders.Enable = False
           .Columns(1).PreferredWidth = CentimetersToPoints(1) 'Position
           .Columns(2).PreferredWidth = CentimetersToPoints(2)   'Art.Nr.
           .Columns(3).PreferredWidth = CentimetersToPoints(7.2) 'Bezeichnung
           .Columns(4).PreferredWidth = CentimetersToPoints(1) 'Menge
           .Columns(5).PreferredWidth = CentimetersToPoints(1.4) 'Einheit
           .Columns(6).PreferredWidth = CentimetersToPoints(2.2)   'Originalpreis
           .Columns(7).PreferredWidth = CentimetersToPoints(2.2)   'Gesamtpreis
       End With
       ueberschrift(6) = ueberschrift(7)
       excelueberschrift(6) = excelueberschrift(7)
       maxspalte = 7
   End If
   
   With wdtab.Range.ParagraphFormat
       .SpaceAfter = 0
       .LineSpacing = LinesToPoints(0.9)
       .Alignment = wdAlignParagraphLeft
   End With

   With wdtab.Range.Cells
       .VerticalAlignment = wdCellAlignVerticalCenter
   End With
   
   With wdtab.Rows(1).Borders(wdBorderTop) 'oberste Umrandung der ersten Zeile
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth025pt
   End With
   With wdtab.Rows(1).Borders(wdBorderBottom) 'untere Umrandung der ersten Zeile
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth150pt
   End With
   With wdtab.Rows(z2 - z1 + 1).Borders(wdBorderBottom) 'letzte Zeile untere Umrandung setzen
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth025pt
   End With
   
   wdtab.Rows.SetHeight RowHeight:=InchesToPoints(0.25), HeightRule:=wdRowHeightAtLeast
   
   'die gesamte Tabelle mit Kopfzeile und den Werten füllen
   For zeile = z1 To z2
       For spalte = 1 To maxspalte
           If zeile = z1 Then
               wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = ueberschrift(spalte - 1)
           Else
               excelspalte = Rows(2).Find(What:=excelueberschrift(spalte - 1), LookAt:=xlWhole, MatchCase:=True).Column
               Select Case spalte
                   Case 5
                       wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = "Paar"
                   Case Else
                       wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = Cells(zeile, excelspalte).Text
               End Select
           End If
       Next spalte
   Next zeile
End Sub


Der Fehler tritt immer an dieser Stelle auf

Code:
.Columns(1).PreferredWidth = CentimetersToPoints(0.9) 'Position


Und das ist die Fehlermeldung:

[
Bild bitte so als Datei hochladen: Klick mich!
]

Weiß jemand woran das liegen kann?
Würde mich freuen.
Ich danke Euch.
Grüße
Hallöchen,

ist wdtab bei jedem Aufruf eine Tabelle?
Betrifft es nur Spalte 1 oder auch die anderen, wenn Du die Zeile(n) auskommentierst?
(27.12.2018, 20:13)Nyn007 schrieb: [ -> ]Ha((o

Habe folgenden Fehler. Jeden zweiten Aufruf erhalten ich immer an der gleichen Stelle eine Fehlermeldung. Dies ist mein Code:

Code:
Sub Tabelle_Generieren(ByRef wddoc As Word.Document, ByRef z1 As Integer)

Dim zeile As Integer
Dim spalte As Integer
Dim maxspalte As Integer
Dim excelspalte As Integer
Dim z2 As Integer
Dim rabatt As Boolean
Dim ueberschrift
Dim excelueberschrift
Dim wdtab As Object

   ueberschrift = Array("Pos", "Art.Nr", "Produkt", "Mg", "Einh", "Preis/E", "Rabatt", "Gesamt")
   excelueberschrift = Array("Pos.", "Art.Nr. SALVAL", "Bezeichnung", "Menge", "Menge2", "UVP Brutto", "Rabatt", "Brutto")

   Call Rechnungsbereich_Festlegen(z1, z2, rabatt)
   
   If rabatt = True Then
       Set wdtab = wddoc.Tables.Add(Range:=wddoc.Bookmarks("Tabelle").Range, NumRows:=z2 - z1 + 1, NumColumns:=8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
       With wdtab
           .Borders.Enable = False
           .Columns(1).PreferredWidth = CentimetersToPoints(0.9) 'Position
           .Columns(2).PreferredWidth = CentimetersToPoints(2)   'Art.Nr.
           .Columns(3).PreferredWidth = CentimetersToPoints(6.5) 'Bezeichnung
           .Columns(4).PreferredWidth = CentimetersToPoints(0.8) 'Menge
           .Columns(5).PreferredWidth = CentimetersToPoints(1.2) 'Einheit
           .Columns(6).PreferredWidth = CentimetersToPoints(2)   'Originalpreis
           .Columns(7).PreferredWidth = CentimetersToPoints(1.6) 'Rabatt
           .Columns(8).PreferredWidth = CentimetersToPoints(2)   'Gesamtpreis
       End With
       wdtab.Columns(8).Select
       'Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
       maxspalte = 8

   Else
       Set wdtab = wddoc.Tables.Add(Range:=wddoc.Bookmarks("Tabelle").Range, NumRows:=z2 - z1 + 1, NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
       With wdtab
           .Borders.Enable = False
           .Columns(1).PreferredWidth = CentimetersToPoints(1) 'Position
           .Columns(2).PreferredWidth = CentimetersToPoints(2)   'Art.Nr.
           .Columns(3).PreferredWidth = CentimetersToPoints(7.2) 'Bezeichnung
           .Columns(4).PreferredWidth = CentimetersToPoints(1) 'Menge
           .Columns(5).PreferredWidth = CentimetersToPoints(1.4) 'Einheit
           .Columns(6).PreferredWidth = CentimetersToPoints(2.2)   'Originalpreis
           .Columns(7).PreferredWidth = CentimetersToPoints(2.2)   'Gesamtpreis
       End With
       ueberschrift(6) = ueberschrift(7)
       excelueberschrift(6) = excelueberschrift(7)
       maxspalte = 7
   End If
   
   With wdtab.Range.ParagraphFormat
       .SpaceAfter = 0
       .LineSpacing = LinesToPoints(0.9)
       .Alignment = wdAlignParagraphLeft
   End With

   With wdtab.Range.Cells
       .VerticalAlignment = wdCellAlignVerticalCenter
   End With
   
   With wdtab.Rows(1).Borders(wdBorderTop) 'oberste Umrandung der ersten Zeile
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth025pt
   End With
   With wdtab.Rows(1).Borders(wdBorderBottom) 'untere Umrandung der ersten Zeile
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth150pt
   End With
   With wdtab.Rows(z2 - z1 + 1).Borders(wdBorderBottom) 'letzte Zeile untere Umrandung setzen
       .LineStyle = xlContinuous
       .LineWidth = wdLineWidth025pt
   End With
   
   wdtab.Rows.SetHeight RowHeight:=InchesToPoints(0.25), HeightRule:=wdRowHeightAtLeast
   
   'die gesamte Tabelle mit Kopfzeile und den Werten füllen
   For zeile = z1 To z2
       For spalte = 1 To maxspalte
           If zeile = z1 Then
               wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = ueberschrift(spalte - 1)
           Else
               excelspalte = Rows(2).Find(What:=excelueberschrift(spalte - 1), LookAt:=xlWhole, MatchCase:=True).Column
               Select Case spalte
                   Case 5
                       wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = "Paar"
                   Case Else
                       wdtab.Cell(zeile - z1 + 1, spalte).Range.Text = Cells(zeile, excelspalte).Text
               End Select
           End If
       Next spalte
   Next zeile
End Sub


Der Fehler tritt immer an dieser Stelle auf

Code:
.Columns(1).PreferredWidth = CentimetersToPoints(0.9) 'Position


Und das ist die Fehlermeldung:

[
Bild bitte so als Datei hochladen: Klick mich!
]

Weiß jemand woran das liegen kann?
Würde mich freuen.
Ich danke Euch.
Grüße

Hast du das Problem lösen können?
Welche Zeile tritt der Fehler laut Microsoft genau auf? Weil den Codeschnipsel hast du 2mal.
@cweimer,

es gab doch nur das eine Problem, das brauchst Du da nicht zu zitieren.