 |
Sub format()
Selection.GoTo What:=wdGoToBookmark, Name:="adresse"
' als erstes werden die Sonderzeichen hier das Zeichen € ersetzt
Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "Û" .Replacement.Text = "€" .Forward = True .Wrap = wdFindContinue .format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll
' nun werden die überflüssigen Zeilen der Positionstabelle entfernt
a = ActiveDocument.Tables(1).Rows.Count ActiveDocument.Tables(1).Rows(a).Select
Do Do While a > 1 ActiveDocument.Tables(1).Columns(6).Cells(a).Select b = Trim(Selection.Text) If Len(b) > 3 Then b1 = Left(b, Len(b) - 3) Else b1 = Left(b, Len(b) - 2) End If If b1 = "" And a > 1 Then ActiveDocument.Tables(1).Rows(a).Select Selection.Cut a = a - 1 Else a = a - 1 Exit Do End If Loop Loop Until b1 <> "" Or a <= 1
If a > 1 Then
' zum Schluss werden die Gesamtbeträge der Rechnung formatiert ' hier fett und doppelt unterstrichen
a = ActiveDocument.Tables(1).Rows.Count ActiveDocument.Tables(1).Columns(6).Cells(a).Select Selection.Font.Underline = wdUnderlineDouble Selection.Font.Bold = wdToggle ActiveDocument.Tables(1).Columns(3).Cells(a).Select Selection.Font.Bold = wdToggle
Selection.MoveUp Unit:=wdLine, Count:=1 End If
End Sub
|
 |
|