Subscribe
in a reader
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:
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:
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!!!
'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.
'-------------------------------------------------------------------------
' 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.
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 (18-2-2011 07:50:01)
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 (20-2-2011 11:07:46)
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 (26-8-2016 11:29:43)
Comment by: Jan Karel Pieterse (26-8-2016 11:56:47)
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: excelexperts.nl/forum/index.php.