Office: Schriftgröße Automatiscch per VBA

Hallo zusammen,
ich habe folgendes Problem:
Kann ich die Schriftgröße automatisch der Zellengröße anpassen.

Code:

Sub Schrift()
Range("G5").Font.Size = Auto   ???? - funktioniert so nicht
End Sub

Die Zellengröße soll beibehalten werden und manchmal steht nur in der Zelle "N" oder so und manchmal "N/S" oder so.
Vielen Dank
Gruß Norbert

 

Hallo Norbert,

im Codemodul des betreffenden Arbeitsblattes folgende Ereignisbehandlungsroutine einfügen (durch Kopieren über die Zwischenablage):

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  With Range("G5")
    .Font.Size = .Height - 2
  End With
End Sub

Allerdings musst Du ins Arbeitsblatt etwas eingeben oder dort etwas ändern, damit sich die Zeichengröße in Zelle G5 automatisch anpasst.
Diese ist dann ca. 2 Punkt kleiner als die Zellenhöhe.

 

Hallo Norbert,


normalerweise einfach auf die gewünschten Zellen rechtsklick->Zellen formatieren->Ausrichtung und dann "An Zellgöße anpassen" aktivieren.

Alternativ könnte man wen es nur um die Höhe der Zelle es vieleicht mal mit sowas probieren:

Code:

Sub schrift_vergr()
Dim wert As Long
Dim zelle As Range
Dim bereich As Range
Set bereich = Range("a1:b20")

For Each zelle In bereich
    wert = Round(zelle.RowHeight, 0) * 0.73
    zelle.Font.Size = wert
Next zelle

End Sub

Gruß Manuel


Ups zu Spät ;-)

 

Hallo Manuel,
zunächst vielen Dank für deine Hilfe.
Das mit dem rechtsklick ist nicht so gut da ich das Blatt geschützt habe um die Formeln zu sichern. Die Zellengröße soll so bleiben wie sie ist, die Höhe ist auch nicht das Problem eer die Breite. Ich habe aber eine Lösung gefunden:

Code:

Sub schrift_vergr() 
Dim wert As Long 
Dim zelle As Range 
Dim bereich As Range 
Set bereich = Range("a1:b20") 

For Each zelle In bereich 
    wert = Round(zelle.RowHeight, 0) * 0.73 
    zelle.Font.Size = wert 
Next zelle 

End Sub

Gruß Norbert

 

Mann der Code ist nartürlich falsch - hier mein Code:-)

Code:

Private Sub CommandButton1_Click()
Dim zelle As Range
Dim bereich As Range

Set bereich = Range("A1:B4")
For Each zelle In bereich
If Right(zelle, 1) = "N" Then
zelle.Font.Size = 10
Else
zelle.Font.Size = 14
End If
Next zelle

End Sub

Gruß Norbert