Format fett
28.02.2007 08:17:13
gio
ich komme nicht mehr so richtig weiter und brauche Eure Hilfe.
Unteres Makro schreibt Etiketten, Werte werden aus einer Tabelle geholt
und dann in einer einzelnen Zelle geschrieben.
Das passt alles prima.
Nun möchte ich aber, daß
a) die Wörter "Breite" und "Höhe" fett ist.
b) die Variablen Breite und Höhe selbst sollten mit Schriftgrad 12 sein.
Wie muß ich unteres Makro ändern, daß das geht.
Vielen Dank im voraus
gio
Option Explicit
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 = 4
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 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) = _
"Kunde: " & Quelle.Cells(Zeile, Zeile1Col) & Chr(10) & _
"Breite: " & Quelle.Cells(Zeile, Zeile2Col) & " " & _ '<-- ev. hier Anpassen?
"Höhe: " & Quelle.Cells(Zeile, Zeile3Col) & Chr(10) & _ '<-- ev. hier Anpassen?
"KW: " & Quelle.Cells(Zeile, Zeile4Col) & Chr(10) & _
"Los: " & Quelle.Cells(Zeile, Zeile5Col)
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