Schrifttyp ändern

Public Sub EtikettenDruck()
'DEFINITIONEN GEGEBENFALLS ANPASSEN
Dim Quelle As Worksheet, Ziel As Worksheet
Set Quelle = Worksheets("Auftrag")
Set Ziel = Worksheets("Etiketten")
Dim MyRange As String
MyRange = "A1:A300"
Dim SpalteStück As Integer
SpalteStück = 7
Dim SpalteZiel As Integer
SpalteZiel = Range(MyRange).Column
Dim ErsteZeileQuelle As Integer, LetzteZeileQuelle As Integer
ErsteZeileQuelle = 4
LetzteZeileQuelle = Quelle.Cells(Rows.Count, SpalteStück).End(xlUp).Row
Dim Zeile1Col As Integer
Zeile1Col = 1
Dim Zeile2Col As Integer
Zeile2Col = 2
Dim Zeile3Col As Integer
Zeile3Col = 3
Dim Zeile4Col As Integer
Zeile4Col = 4
Dim Zeile5Col As Integer
Zeile5Col = 5
Dim Zeile6Col As Integer
Zeile6Col = 6
Dim Zeile7Col As Integer
Zeile7Col = 7
Dim Zeile8Col As Integer
Zeile8Col = 8
Dim Zeile9Col As Integer
Zeile9Col = 9
Dim Zeile10Col As Integer
Zeile10Col = 10
Dim AnzahlEtiketten As Integer
'ENDE DEFINITIONEN
'ETIKETTEN ERZEUGEN
Ziel.Cells.Clear 'löschen aller Inhalte in Etiketten
Dim ZeileZiel As Integer, Zeile As Integer
ZeileZiel = Range(MyRange).Row
For Zeile = ErsteZeileQuelle To LetzteZeileQuelle
Ziel.Cells(ZeileZiel, SpalteZiel) = _
"K: " & Quelle.Cells(Zeile, Zeile1Col) & "     " & _
"BG: " & Quelle.Cells(Zeile, Zeile2Col) & "     " & _
"Lage: " & Quelle.Cells(Zeile, Zeile3Col) & Chr(10) & _
"                                    Breite: " & Quelle.Cells(Zeile, Zeile4Col) & "     " & _
"Höhe: " & Quelle.Cells(Zeile, Zeile5Col) & "     " & _
"Länge: " & Quelle.Cells(Zeile, Zeile6Col) & Chr(10) & _
"                                    Schnitt1: " & Quelle.Cells(Zeile, Zeile8Col) & "     " & _
"Schnitt2: " & Quelle.Cells(Zeile, Zeile9Col) & Chr(10) & _
"                                    T: " & Quelle.Cells(Zeile, Zeile10Col)
'Formatierung Breite
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "   _
_
_
_
_
Breite:"), Length:=12).Font.FontStyle = "Fett"
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "   _
_
_
_
_
Breite:"), Length:=12).Font.Size = "10"
'Formatierung Höhe
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "Hö _
_
_
_
_
he:"), Length:=10).Font.FontStyle = "Fett"
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "Hö _
_
_
_
_
he:"), Length:=10).Font.Size = "10"
'Formatierung Länge
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "Lä _
_
_
_
_
nge:"), Length:=11).Font.FontStyle = "Fett"
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel), "Lä _
_
_
_
_
nge:"), Length:=11).Font.Size = "10"
'Formatierung BG
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel),  _
Quelle.Cells(Zeile, Zeile2Col)), Length:=4).Font.FontStyle = "Fett"
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel),  _
Quelle.Cells(Zeile, Zeile2Col)), Length:=4).Font.Size = "12"
'Formatierung Lage
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel),  _
Quelle.Cells(Zeile, Zeile3Col)), Length:=5).Font.FontStyle = "Fett"
Ziel.Cells(ZeileZiel, SpalteZiel).Characters(Start:=InStr(Ziel.Cells(ZeileZiel, SpalteZiel),  _
Quelle.Cells(Zeile, Zeile3Col)), Length:=5).Font.Size = "12"
xxxxxxxxxan dieser Stelle zusätzlich Schrifttyp WIndings 3xxxxxx
ZeileZiel = ZeileZiel + 1
For AnzahlEtiketten = 1 To Quelle.Cells(Zeile, SpalteStück) - 1
Ziel.Cells(ZeileZiel, SpalteZiel) = Ziel.Cells(ZeileZiel - 1, SpalteZiel)
ZeileZiel = ZeileZiel + 1
Next AnzahlEtiketten
Next Zeile
'ETIKETTEN DRUCKEN
MyRange = Left(MyRange, InStr(MyRange, ":")) & Cells(ZeileZiel - 1, SpalteZiel).Address
Ziel.PageSetup.PrintArea = MyRange
'Ziel.PrintOut Copies:=1, Collate:=True
End Sub