|
Sub serienbrief()
Set oWord = CreateObject("Word.Application")
Sheets("Anlage").Select
Cells.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Öffnen der Dokumentvorlage
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With oFileDialog
.Title = "Wählen Sie bitte das Anschreiben an den Kunden aus!"
.ButtonName = "Weiter"
.AllowMultiSelect = False
.InitialFileName = ActiveWorkbook.Path
If .Show = True Then
'.SelectedItems
End If
End With
Sheets("Anschreiben").Activate
Cells(3, 8).Activate
Do
Selection.End(xlDown).Select
Loop Until ActiveCell.Row = 65536
Selection.End(xlUp).Select
last_row = ActiveCell.Row
Sheets("Anlage").Activate
Cells(3, 5).Activate
Do
Selection.End(xlDown).Select
Loop Until ActiveCell.Row = 65536
Selection.End(xlUp).Select
last_row_a = ActiveCell.Row
For z = 3 To last_row
oWord.Documents.Open oFileDialog.SelectedItems(1)
oWord.Application.Visible = True
Set odoc = oWord.ActiveDocument
odoc.Bookmarks("Name").Range.Text = Sheets("Anschreiben").Cells(z, 9) & " " & Sheets("Anschreiben").Cells(z, 10)
odoc.Bookmarks("Straße").Range.Text = Sheets("Anschreiben").Cells(z, 13)
odoc.Bookmarks("Ort").Range.Text = Sheets("Anschreiben").Cells(z, 14) & " " & Sheets("Anschreiben").Cells(z, 15)
odoc.Bookmarks("UstID").Range.Text = Sheets("Anschreiben").Cells(z, 16)
summe = 0
summe_vst = 0
t = 2
For x = 2 To last_row_a
If Sheets("Anlage").Cells(x, 4) = Sheets("Anschreiben").Cells(z, 4) Or Sheets("Anlage").Cells(x, 4) = Sheets("Anschreiben").Cells(z, 6) Then
If (t - 25) Mod 27 = 0 Or t = 25 Then
summe = summe + Round(Sheets("Anlage").Cells(x, 8), 2)
summe_vst = summe_vst + Round(Sheets("Anlage").Cells(x, 9), 2)
odoc.Tables(1).Columns(1).Cells(t).Range.Text = "Ursprüngliche Rechnungs- bzw. Gutschriftsnummer"
odoc.Tables(1).Columns(2).Cells(t).Range.Text = "Belegdatum"
odoc.Tables(1).Columns(3).Cells(t).Range.Text = "Nettobetrag"
odoc.Tables(1).Rows(t).Range.Bold = True
odoc.Tables(1).Rows(t).Select
odoc.Tables(1).Rows(t).Shading.BackgroundPatternColor = wdColorGray15
odoc.Tables(1).Rows.Add
t = t + 1
odoc.Tables(1).Rows(t).Shading.BackgroundPatternColor = wdColorAutomatic
odoc.Tables(1).Rows(t).Range.Bold = False
odoc.Tables(1).Columns(1).Cells(t).Range.Text = Sheets("Anlage").Cells(x, 5)
odoc.Tables(1).Columns(2).Cells(t).Range.Text = Sheets("Anlage").Cells(x, 6)
odoc.Tables(1).Columns(3).Cells(t).Range.Text = Format(Round(Sheets("Anlage").Cells(x, 8), 2), "##,##0.00") & " EUR"
odoc.Tables(1).Rows.Add
t = t + 1
If t = 2 Then odoc.Bookmarks("Belegdatum1").Range.Text = Sheets("Anlage").Cells(x, 6)
Else
If t = 2 Then odoc.Bookmarks("Belegdatum1").Range.Text = Sheets("Anlage").Cells(x, 6)
summe = summe + Round(Sheets("Anlage").Cells(x, 8), 2)
summe_vst = summe_vst + Round(Sheets("Anlage").Cells(x, 9), 2)
odoc.Tables(1).Columns(1).Cells(t).Range.Text = Sheets("Anlage").Cells(x, 5)
odoc.Tables(1).Columns(2).Cells(t).Range.Text = Sheets("Anlage").Cells(x, 6)
odoc.Tables(1).Columns(3).Cells(t).Range.Text = Format(Round(Sheets("Anlage").Cells(x, 8), 2), "##,##0.00") & " EUR"
odoc.Tables(1).Rows.Add
'pagecount = odoc.ComputeStatistics(wdStatisticPages)
t = t + 1
End If
End If
Next x
odoc.Bookmarks("Belegdatum2").Range.Text = Left(odoc.Tables(1).Columns(2).Cells(t - 1).Range.Text, Len(odoc.Tables(1).Columns(2).Cells(t - 1).Range.Text) - 2)
odoc.Tables(1).Columns(1).Cells(1 + t).Range.Text = "Summe"
odoc.Tables(1).Columns(1).Cells(1 + t).Range.Bold = True
odoc.Tables(1).Columns(3).Cells(1 + t).Range.Text = Format(summe, "##,##0.00")
Sheets("Auswertungen").Cells(z, 1) = Sheets("Anschreiben").Cells(z, 4)
Sheets("Auswertungen").Cells(z, 2) = Format(summe, "##,##0.00")
Sheets("Auswertungen").Cells(z, 3) = Format(summe_vst, "##,##0.00")
odoc.Tables(1).Columns(3).Cells(1 + t).Range.Bold = True
odoc.SaveAs odoc.Path & "\Berichtigungsschreiben\Anschreiben_" & Sheets("Anschreiben").Cells(z, 4) & ".doc"
odoc.Close
Next z
Set odoc = Nothing
Word.Application.Quit
Sheets("Anschreiben").Select
End Sub
|