Autofit - VBA

Du kan vlæe bare lade være med at bruge den :-)

Eller mener du, om man med VBA kabn forhindre brugerne i at bruge Auutofit i regnearket?

Årsagen til at jeg har brug for funktionen er, at jeg tror Autofit tidligere har været anvendt i arket. Jeg kan ikke se hvordan men kan slå det fra når det en gang er anvendt.

Mit problem er, at mine rækker ændre sig når jeg skriver i dem (rækkehøjden). Rækkehøjden sætter automatisk til 13?

Autofit er så vidt jeg ved ikke noget, der slås til og fra. Det er en standardegenskab ved Excel, hvis du skriver flere linier i en celle, ændrer punktstørrelse mm.

Hvad er det, du ønsker at opnå?

Jeg har udarbejdet et ark der anvendes til at udarbejde faneblade i. For at kunne udarbejde alle typer af faneblade i arket skal den automatisk tilpasse rækkehøjden. Det har jeg fået til at virke fint, men når jeg så skriver i cellerne ændres rækkehøjden til 13 og det skal den jo ikke.

Bliver den altid 13 uanswet punktstørrrelse?

Ja den bliver altid 13

Det lyder godt nok mærkeligt

Med mindre at rækkerne som udgangspunkt er formateret til at være 13 høje, for så vil den altid forblive det. Hvis de ikke er formaterede, burde højden ændre sig efter behov.

Et eksempel fra mit program ser således ud for indeks 1-5 og indeks 1-6 (henholdsvis 5 og 6 faner) - rækkehøjden er dermed fastsat:

'Indeks 1-5
Sub L15()
    Application.ScreenUpdating = False
    Ark2.Range("b2") = "'1-5"
    Ark2.Range("a2") = 5
    Ark2.Range("IndexType") = 1
    RowHeight
    ColumnsShow
    Font
End Sub

'Indeks 1-6
Sub L16()
    Application.ScreenUpdating = False
    Ark2.Range("b2") = "'1-6"
    Ark2.Range("a2") = 6
    Ark2.Range("IndexType") = 1
    RowHeight
    ColumnsShow
    Font
End Sub

Sub RowHeight()

Ark3.Select

I = 1

For I = 1 To 54

With Ark3.Rows(I)
    .RowHeight = Range("H" & I).Value
End With

Next I

End Sub

Sub ColumnsShow()
    Ark3.Select
   
'Columnwidth

    Columns("B:E").ColumnWidth = Ark2.Range("ColumnWidthIndex").Value
    Columns("F:F").ColumnWidth = Ark2.Range("ColumnWidthText").Value
   
'Reset Hidden columns

    If Columns("B:B").EntireColumn.Hidden = False Then
        Columns("B:B").EntireColumn.Hidden = True
    End If
    If Columns("C:C").EntireColumn.Hidden = False Then
        Columns("C:C").EntireColumn.Hidden = True
    End If
    If Columns("D:D").EntireColumn.Hidden = False Then
        Columns("D:D").EntireColumn.Hidden = True
    End If
    If Columns("E:E").EntireColumn.Hidden = False Then
        Columns("E:E").EntireColumn.Hidden = True
    End If

'Hide columns

    If Ark2.Range("IndexType").Value = 1 Then
        Columns("B:B").EntireColumn.Hidden = False
    End If
    If Ark2.Range("IndexType").Value = 2 Then
        Columns("C:C").EntireColumn.Hidden = False
    End If
    If Ark2.Range("IndexType").Value = 3 Then
        Columns("D:D").EntireColumn.Hidden = False
    End If
    If Ark2.Range("IndexType").Value = 4 Then
        Columns("E:E").EntireColumn.Hidden = False
    End If
   
End Sub


'Font settings

Sub Font()

    Ark3.Columns("B:E").Select
    With Selection.Font
        .Name = "Arial"
        .Size = Ark2.Range("FontIndex").Value
    End With
   
 
    Ark3.Columns("F:F").Select
    With Selection.Font
        .Name = "Arial"
        .Size = Ark2.Range("FontText").Value
    End With

    Ark3.Range("F1").Select
   
    Application.ScreenUpdating = True
End Sub

Hvad står der i H-kolonnen?

Der står rækkehøjden som et tal

Og det er ikke 13? Hos mig virker det nydeligt. Har du prøvet din kode i et andet ark?

Tak jkrons

Dine bemærkninger fik mig til at opdate føgende funktion under ThisWorkbook :-)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Selection.RowHeight = 13
End Sub

Jeg ved ikke hvordan den er kommet der, men jeg har nok testet med den tidligere ;-)

Tak for hjælpen og din tid - lægger du et svar?

Se i øvrigt mit tilægsspørgsmål http://www.eksperten.dk/spm/859935

Et svar :-)