Most Valuable Professional


View Jan Karel Pieterse's profile on LinkedIn subscribe to rss feed
Subscribe in a reader

Subscribe to our mailing list

* indicates required

Bestand crasht Excel!!

Red mijn werkmap!
De beste tool voor Excel bestanden met problemen.

Cursussen

Excel VBA Masterclass (Engels)
Excel VBA voor Financials

Third party tools

Speed up your file

FastExcel
The best tool to optimise your Excel model!

Repair your file

Stellar Phoenix Excel Repair
Best tool to repair corrupt Excel sheets and objects
Home > Nederlandse site > Artikelen > Opmaak profielen in Excel > VBA voorbeelden
This page in English

Opmaak profielen in Excel

VBA voorbeelden en hulpprogrammaatjes

Onderstaande hulp programmaatjes kunnen jouw dagelijks gebruik van opmaak profielen vergemakkelijken en tonen tevens hoe het gebruik van opmaakprofielen in VBA in zijn werk gaat.

Opzoeken van cellen met een bepaald profiel

Onderstaande code zoekt naar cellen die een opmaakprofiel hebben met "demo" in de naam:

Sub FindaStyle()
    Dim oSh As Worksheet
    Dim oCell As Range
    For Each oSh In ThisWorkbook.Worksheets
        For Each oCell In oSh.UsedRange.Cells
            If oCell.Style Like "*demo*" Then
                Application.GoTo oCell
                Stop
            End If
        Next
    Next
End Sub

Zodra een cel hieraan voldoet stopt de uitvoering van de code ("Stop") en krijg je de mogelijkheid de cel te bekijken.

Een lijst van opmaakprofielen maken

Onderstaande code maakt op een werkblad genaamd "Config - Styles" een lijst met de aanwezige opmaakprofielen:

Sub ListStyles()
    Dim oSt As Style
    Dim oCell As Range
    Dim lCount As Long
    Dim oStylesh As Worksheet
    Set oStylesh = ThisWorkbook.Worksheets("Config - Styles")
    With oStylesh
        lCount = oStylesh.UsedRange.Rows.Count + 1
        For Each oSt In ThisWorkbook.Styles
            On Error Resume Next
            Set oCell = Nothing
            Set oCell = Intersect(oStylesh.UsedRange, oStylesh.Range("A:A")).Find(oSt.Name, _
                oStylesh.Range("A1"), xlValues, xlWhole, , , False)
            If oCell Is Nothing Then
            lCount = lCount + 1
            .Cells(lCount, 1).Style = oSt.Name
            .Cells(lCount, 1).Value = oSt.NameLocal
            .Cells(lCount, 2).Style = oSt.Name
            End If
        Next
    End With
End Sub

Opmaak van cellen verwijderen en opmaakprofielen opnieuw instellen

Onderstaande code verwijdert alle opmaak van alle cellen van uw bestand en past vervolgens het opmaakprofiel opnieuw op de cellen toe.

Pas op: je raakt dus veel opmaak kwijt als je geen zorgvuldig gebruik hebt gemaakt van opmaakprofielen!!!

Sub ReApplyStyles()
'Resets styles of cells to their original style (resets all formatting done on top of ANY style)
    Dim oCell As Range
    Dim oSh As Worksheet
    If MsgBox("Proceed with care:" & vbNewLine & vbNewLine & _
              "This routine will erase all formatting done on top of the existing cell styles." & vbNewLine & _
              "Continue?", vbCritical + vbOKCancel + vbDefaultButton2, GSAPPNAME) = vbOK Then
        For Each oSh In ActiveWindow.SelectedSheets
            For Each oCell In oSh.UsedRange.Cells
                If oCell.MergeArea.Cells.Count = 1 Then
                    oCell.Style = CStr(oCell.Style)
                End If
            Next
        Next
    End If
End Sub

Opmaakprofielen vervangen door een ander profiel

Onderstaande code gebruikt een lijst met twee kolommen; in de linker kolom staat het huidige opmaakprofiel, in de rechter een vervangend opmaakprofiel. de code zoekt vervolgens alle cellen met het linker opmaakprofiel en vervangt dit door het rechter. Ideaal om opruiming te houden. Selecteer voor uitvoeren van de code de cellen in de linker kolom die je wil laten verwerken.

Sub FixStyles()
'-------------------------------------------------------------------------
' Procedure : FixStyles
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse
' Created   : 4-10-2007
' Purpose   : Replaces styles with the replacement style as defined by a two column list.
'             column 1 should contain the existing style, col 2 the replacing style
'-------------------------------------------------------------------------
    Dim sOldSt As String
    Dim sNewSt As String
    Dim oSh As Worksheet
    Dim oCell As Range
    Dim oSourceCell As Range
    Set oSourceCell = ActiveCell
    While oSourceCell.Value <> ""
        sOldSt = oSourceCell.Value
        sNewSt = InputBox("Please enter replacement style for:" & sOldSt, "Style changer", oSourceCell.Offset(, 1).Value)
        If sNewSt = "" Then Exit Sub
        If sNewSt <> "" And sNewSt <> sOldSt Then
            For Each oSh In ThisWorkbook.Worksheets
                For Each oCell In oSh.UsedRange
                    If oCell.Style = sOldSt Then
                        Application.GoTo oCell
                        On Error Resume Next
                        oCell.Style = sNewSt
                    End If
                Next
            Next
        End If
        Set oSourceCell = oSourceCell.Offset(1)
    Wend
End Sub

Formattering verwijderen van een tabel

Stel dat je net een bereik naar een tabel hebt omgezet (Zie dit artikel), maar het oorspronkelijke bereik had je voorzien van allerlei opmaak zoals randen en opvulkleuren. Tabellen hebben hun eigen tabel stijlen, maar die overschrijven formattering die je zelf hebt gedaan niet. Wat je kunt doen is de Standaard stijl toepassen op de tabel, maar dat zorgt ervoor dat al je getalsopmaak verdwijnt. Onderstaand macrootje maakt eerst een nieuwe stijl en zet het getalsopmaak gedeelte van die stijl uit. Als die stijl op de tabel wordt toegepast behoud je de getalsopmaak.

Sub RemoveFormattingOfTable()
    Dim oStNormalNoNum As Style
    On Error Resume Next
    Set oStNormalNoNum = ActiveWorkbook.Styles("NormalNoNum")
    On Error GoTo 0
    If oStNormalNoNum Is Nothing Then
        ActiveWorkbook.Styles.Add "NormalNoNum"
        Set oStNormalNoNum = ActiveWorkbook.Styles("NormalNoNum")
        oStNormalNoNum.IncludeNumber = False
    End If
    With ActiveSheet.ListObjects(1)
        .Range.Style = "NormalNoNum"
        'Now apply tablestyle:
        .TableStyle = "TableStyleLight1"
    End With
    ActiveWorkbook.Styles("NormalNoNum").Delete
End Sub

 


Vragen, suggesties en opmerkingen

Al het commentaar over deze pagina:


Comment by: Guido Peeters (2/18/2011 7:50:01 AM)

Hoe formaat foto's in rapport - allemaal tegelijk -aanpassen ?
AllpictSize ?

PS My e-mailadress (gp@respm.be) is out of order until Monday 21-02-11(I presume ...)
Guido Peeters (0032 478 56 06 61)

 


Comment by: Jan Karel Pieterse (2/20/2011 11:07:46 AM)

Hallo Guido,

Selecteer alle plaatjes door de control toets ingedrukt te haouden en erop te klikken. Heb je ze allemaal geselecteerd, druk dan op control+1 om hun eigenschappen te wijzigen.

 


Comment by: Luc Vansteenkiste (8/26/2016 11:29:43 AM)

Hoe maak ik een macro om rijen in te voegen op een willekeurige plaats en daarna de opmaak te kopiėren van een andere selectie.

 


Comment by: Jan Karel Pieterse (8/26/2016 11:56:47 AM)

Hallo Luc,

Heb je al iets geprobeerd? Bijvoorbeeld een macro opnemen waarbij je het handmatig doet?

 


Heeft u vragen, suggesties of opmerkingen? Gebruik dan dit formulier.

Mocht uw vraag niet direct relevant zijn voor deze pagina, maar een algemene Excel vraag betreffen, dan adviseer ik om deze hier te stellen: www.eileenslounge.com.

Uw naam (verplicht veld):

Uw e-mail adres (Niet verplicht, dit adres wordt niet getoond)

Uw verzoek of commentaar:

Als u VBA code in uw commentaar plaatst, gebruik dan [VB] tags: [VB]Uw code[/VB].