Wat is de echte Font.Size na 'Tekst passend maken'

Status
Niet open voor verdere reacties.
V

Visara

Gebruiker
Lid geworden
10 mrt 2019
Berichten
217
Goedendag,

Twee Ranges hebben beiden dezelfde Font.Size & zijn opgemaakt met 'Tekst passend maken'.
De inhoud is variabel.
Soms wordt de grootte van inhoud van een of beide Ranges automatisch kleiner gemaakt door de opmaak 'Tekst passend maken'.
Ik wil de gebruiker dmv een checkbox de mogelijkheid geven de grootste tekst qua grootte aan te passen aan de kleinste tekst.
Dit kan de gebruiker ook weer uitzetten, als hij/zij dat wenst, door de checkbox weer uit te vinken.

Met de code hier onder lukt dat alleen met de INGESTELDE Font.Size. Maar ik wil juist met de daadwerkelijke 'Font.Size' werken.

Code: 
Private Sub CheckBox1_Click()
       
    If CheckBox1 = True Then
    
    If Range("B4").Font.Size < Range("B5").Font.Size Then
            Range("B5").Font.Size = Range("B4").Font.Size
        
    ElseIf Range("B5").Font.Size < Range("B4").Font.Size Then
            Range("B4").Font.Size = Range("B5").Font.Size
    
    End If
    End If
    End Sub

Met vriendelijke groet,
Visara
 

Bijlagen

  • VraagVoorForum.xlsm
    47,7 KB · Weergaven: 37
Als je tekst passend maakt dan veranderd er niets aan de Font.Size alleen ziet het er op jouw scherm anders uit. Samengevoegde cellen moet je al helemaal niet willen gebruiken.

Aan code lijkt mij dit voldoende
Code: 
Private Sub CheckBox1_Click()
  If CheckBox1 Then Range("B4:B5").Font.Size = Application.Min(Range("B4").Font.Size, Range("B5").Font.Size)
End Sub
 
Ik vermoede al dat het niet kon, maar hoopte dat er iets bestond als een .Font.Actualsize oid.
Bedankt voor uw tijd en de moeite die u nam om de veel compactere code te laten zien.

Met terugwerkende kracht verklaar ik mijn vraag als "Is het mogelijk om (...)"
Het antwoord is dus 'nee', ik zet mijn vraag als opgelost. ;)
 
Laatst bewerkt:
Zo kan het (in principe).
Maakte een kopie van de samengevoegde cellen in het blad "Test".
Een gaat vervolgens in een lus het font steeds 1 puntje kleiner maken.
N.B het eindresultaat kan er (optisch gezien) 1 punt naast zitten, en werkt alleen maar van groot font naar klein font.

Code: 
Public Sub GetFontSizeFitText()

    With Sheets("Blad1").Range("B5")
        lBreedte1 = .MergeArea.Columns.Width
        .Copy

    End With

    With ThisWorkbook
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "Test"
    End With

    With Sheets("Test").Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        Do
            .Font.Size = .Font.Size - 1
            .Columns.AutoFit
            lBreedte2 = .Columns.Width
        Loop Until lBreedte2 < lBreedte1
        MsgBox "Font size: " & .Font.Size
    End With

    Sheets("TEST").Delete

End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan