Returnere hvor mange tegn det er plass til i kolonnebredden

Så lenge man benytter standard font i regnearket har dette en enkel og grei løsning:
ActiveCell.ColumnWidth vil returnere et tall som forteller hvor mange tegn det i gjennomsnitt er plass til i kolonnebredden, forutsatt at du benytter samme skrift som er definert i Normal-stilen.

Dersom du ikke benytter standard-fonten kan du få hjelp av funksjonen nedenfor til å finne ut av hvor mange tegn det i gjennomsnitt er plass til i en kolonne basert på en selvvalgt font:

Function GetColumnCharsCount(rngInputCell As Range, strFont As String, intSize As Integer, _
    blnBold As Boolean, blnItalic As Boolean) As Double
' returnerer gjennomsnittlig antall tegn som vil passe i rngInputCell for angitt font
' rngInputCell er ment å være en enkelt celle, 
' den kan ikke være en celle i den siste kolonnen i et regneark
' eksempler:
' dblResult = GetColumnCharsCount(ActiveCell, "Arial", 14, True, False)
' dblResult = GetColumnCharsCount(Range("A1"), "Arial Narrow", 8, False, False)
Dim s As Style, asu As Boolean, c As Long, dblPixels(0 To 2) As Double
Dim strFont1 As String, intSize1 As Integer, blnBold1 As Boolean, blnItalic1 As Boolean, _
dblColWidth As Double
    If rngInputCell Is Nothing Then Exit Function
    On Error Resume Next
    Set s = ActiveWorkbook.Styles("Normal")
    On Error GoTo 0
    If s Is Nothing Then Exit Function
    asu = Application.ScreenUpdating
    If asu Then
        Application.ScreenUpdating = False
    End If
    With s.Font
        ' lagrer originalinnstillingene for Normal stilen
        strFont1 = .Name
        intSize1 = .Size
        blnBold1 = .Bold
        blnItalic1 = .Italic
        dblColWidth = rngInputCell.ColumnWidth
        ' gjennomsnittlig tegn/pixel
        dblPixels(1) = dblColWidth / (rngInputCell.Offset(0, 1).Left - rngInputCell.Left) 
        ' midlertidig endring av Normal stilen
        .Name = strFont
        .Size = intSize
        .Bold = blnBold
        .Italic = blnItalic
        ' gjennomsnittlig tegn/pixel
        dblPixels(2) = dblColWidth / (rngInputCell.Offset(0, 1).Left - rngInputCell.Left)
        ' gjenopprett innstillingene for Normal stilen
        .Name = strFont1
        .Size = intSize1
        .Bold = blnBold1
        .Italic = blnItalic1
    End With
    If asu Then
        Application.ScreenUpdating = True
    End If
    ' beregn resultatet
    GetColumnCharsCount = dblColWidth * dblPixels(2) / dblPixels(1)
End Function

Sub TestGetColumnCharsCount()
Dim dlbResult As Double
    dlbResult = GetColumnCharsCount(ActiveCell, "Verdana", 14, True, False)
    MsgBox "Den aktive cellen kan i gjennomsnitt vise " & Format(dlbResult, "0.0") & _ 
        " tegn i Verdana 14 punkt halvfet skrift!", vbInformation
End Sub

Dokumentet er sist oppdatert 2006-01-27 11:10:57 Utskriftsvennlig versjon