Anzeige
Archiv - Navigation
1168to1172
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schriftgröße bei Mehrzeiligen Zellen ändern

Schriftgröße bei Mehrzeiligen Zellen ändern
Tobias
Hallo,
ich hab folgendes Problem.
Ich habe in einer Zelle 3 Zeilen.
Z. B.
1.Zeile
2.Zeile
3.Zeile
Nun möchte ich, dass die 1. Zeile fett und in der Schriftgröße 16 dargestellt wird.
Zeile 2 und 3 soll in der Schriftgröße 9 dargestellt werden.
und alles soll zentriert sein. Horizontal und vertikal
Das bekomm ich ja auch hin.
Nun möchte ich diese Formatierung auf die restlichen 100 Zellen in meinem Dokument übernehmen.
Wenn ich das nun mit der Funktion "Format übertragen" also dem Pinsel mache,
macht er mir alle 3 Zeilen in Schriftgröße 16 und Fett.
Wie kann ich das lösen?
Gibt es hier eventuell ein Makro und wie muss das dann mit der Formatierung gemacht werden?
AW: Schriftgröße bei Mehrzeiligen Zellen ändern
04.08.2010 14:04:58
Tino
Hallo,
kannst mal diesen Code testen.
Sub test()
Dim rngBereich As Range

'Bereich anpassen 
Set rngBereich = Range("A1:A100")

Application.ScreenUpdating = False
    With rngBereich
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
            
        For Each rngBereich In .Cells
            If rngBereich <> "" Then
                With rngBereich
                    
                    With .Characters(Start:=1, Length:=InStr(rngBereich, Chr(10))).Font
                        .Size = 16
                        .ColorIndex = 3
                        .Bold = True
                    End With
                    
                End With
            End If
        Next rngBereich
    End With
Application.ScreenUpdating = True
End Sub
Gruß Tino
Anzeige
Ist der Zeilumbruch manuell erzeugt (ALT+ENTER)?oT
04.08.2010 14:05:32
Matthias5
AW: Ist der Zeilumbruch manuell erzeugt (ALT+ENTER)?oT
04.08.2010 14:27:05
Tobias
Hallo Matthias,
ja der Umbruch ist manuell erzeugt.
Hast ja schon eine Lösung von Tino bekommen...
04.08.2010 14:32:08
Tino
Hi Tobias,
ich gehe mal davon aus, dass der Vorschlag von Tino dein Problem löst. Du musst ja nur noch Schriftgröße 9 voreinstellen und ggf. die Schriftfarbe rot aus dem Code entfernen.
Gruß,
Matthias
AW: Hast ja schon eine Lösung von Tino bekommen...
04.08.2010 14:47:48
Tino
ja genau das funktioniert auch bestens!
Danke euch beiden!!!
Super sache!!!
Schriftformatierung mehrzeiliger Zellen kopieren
04.08.2010 15:34:29
NoNet
Hallo Tobias,
hier noch eine Lösung von mir : Die einzelnen Schriftformatierungen der mehrzeiligen Zelle A1 (bitte im Code anpassen !) wird auf die gerade markierten Zellen übertragen :
VBA-Code:
Sub ZeichenFormatierungKopieren()
    'Überträgt das Schriftformat einer mehrzeiligen Zelle mit Zeilenumbruch auf andere Zellen
    '04.08.2010, NoNet - www.excelei.de
    Dim rngOriginal As Range, rngZelle As Range
    Dim intI As Integer, intS As Integer, intT As Integer, intZ As Integer
    Dim intZeile(0 To 9) 'Maximal 10 Zeilen pro Zelle
    Set rngOriginal = [A1] 'A1 ist die Zelle mit der zu übernehmenden Formatierung
    'Zuerst wird ermittelt, wo die Zeilenumbrüche enthalten sind - max. 10 Zeilen pro Zelle :
    intZeile(0) = 0: intI = 1
    While InStr(intS + 1, rngOriginal.Value, Chr(10)) And intI < 10
        intS = InStr(intS + 1, rngOriginal.Value, Chr(10))
        intZeile(intI) = intS + 1
        intI = intI + 1
    Wend
    'Die Schriftformatierung des ersten Zeichens je Zeile aus der Originalzelle
    'wird auf die entsprechenden Zeilen der markierten Zellen übertragen
    'Selection sind die markierten Zellen, auf die das Format übertragen werden soll
    For Each rngZelle In Selection
        If rngZelle.Value <> "" Then
            intT = 0: intZ = 0
            Do
                intS = intT
                intT = InStr(intS + 1, rngZelle.Value, Chr(10))
                If intT = 0 Then intT = Len(rngZelle.Value)
                With rngZelle.Characters(intS + 1, IIf(intZ >= intI, 255, intT - intS)).Font
                    .Name = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Name
                    .FontStyle = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.FontStyle
                    .Size = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Size
                    .Strikethrough = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Strikethrough
                    .Superscript = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Superscript
                    .Subscript = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Subscript
                    .OutlineFont = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.OutlineFont
                    .Shadow = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Shadow
                    .Underline = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.Underline
                    .ColorIndex = rngOriginal.Characters(intZeile(IIf(intZ < intI, intZ, intI - 1)), 1).Font.ColorIndex
                End With
                If intZ < intI Then
                    intZ = intZ + 1
                Else
                    intZ = intI + 1
                End If
            Loop While intZ <= intI
        End If
    Next
End Sub
Ausschlaggebend für die Formatierung ist das erste Zeichen einer Zeile innerhalb der Zelle !
Gruß, NoNet
Anzeige

109 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige