27.12.2018, 21:13
Ha((o
Habe folgenden Fehler. Jeden zweiten Aufruf erhalten ich immer an der gleichen Stelle eine Fehlermeldung. Dies ist mein Code:
Der Fehler tritt immer an dieser Stelle auf
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
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 SubDer Fehler tritt immer an dieser Stelle auf
Code:
.Columns(1).PreferredWidth = CentimetersToPoints(0.9) 'PositionUnd 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
