KLEUREN KIEZEN IN ACCESS FROMULIER MET DANK AAN COPILOT.
ZET DIT IN EEN MODULE.
Option Compare Database “Staat er al
Option Explicit “Staat er al
Private Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private CustomColors(0 To 15) As Long
'************************************************************
' Fuctie voor oproepen Windows kleuren selector, geeft waarde terug voor code in formulier voor ‘ ‘ ‘ ‘ ´ instellen kleur. Kan voorgrond als achtergrond zijn.
Public Function KiesKleur() As Long
Dim cc As ChooseColor
cc.lStructSize = LenB(cc)
cc.hwndOwner = Application.hWndAccessApp
cc.lpCustColors = VarPtr(CustomColors(0))
cc.Flags = &H1 Or &H2 ' CC_RGBINIT + CC_FULLOPEN
If ChooseColor(cc) Then
KiesKleur = cc.rgbResult
Else
KiesKleur = -1 ' Geen kleur gekozen
End If
End Function
OM DIT TE TESTEN:
Type in de “Direct sectie” van de “VBA_editor “?KiesKleur()”
ACHTERGRONDKLEUR:
Om toe te passen: Maak knop in formulier "Gebeurtenis bij klikken"
Plaats deze code tussen wat je al geboden wordt voor de achtergrond kleur:
Dim kleur As Long
kleur = KiesKleur()
If kleur <> -1 Then
Me.Section(acDetail).BackColor = kleur
Else
Beep
MsgBox "Geen kleur gekozen."
End If
TEKSTKLEUR:
Note: Forecolor werkt alleen op besturingselementen.
Om Toe te passen maak knop in formulier "gebeurtenis bij klikken"
Plaats deze code tussen wat ja al geboden wordt voor de tekstkleur.
Dim kleur As Long
Dim ctl As Control
kleur = KiesKleur()
If kleur <> -1 Then
' Pas kleur toe op txtNaam (optioneel, als je dit veld expliciet wilt aanpassen)
Me.Id.ForeColor = kleur
' Pas kleur toe op alle besturingselementen in de Detail-sectie
For Each ctl In Me.Controls
If ctl.Section = acDetail Then
On Error Resume Next
ctl.ForeColor = kleur
On Error GoTo 0
End If
Next ctl
Else
MsgBox "Geen kleur gekozen."
End If
(Optionee) Bij mij is in het toe te passen formulier is het eerste veld ME.ID.Forecolor = Kleur
Met dit toe te passen heb ik legio regels code en tabellen verwijderd, nogmaals dank aan Copilot.
Door mij Typfouten daargelaten.
MVG, John vd V.
ZET DIT IN EEN MODULE.
Option Compare Database “Staat er al
Option Explicit “Staat er al
Private Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private CustomColors(0 To 15) As Long
'************************************************************
' Fuctie voor oproepen Windows kleuren selector, geeft waarde terug voor code in formulier voor ‘ ‘ ‘ ‘ ´ instellen kleur. Kan voorgrond als achtergrond zijn.
Public Function KiesKleur() As Long
Dim cc As ChooseColor
cc.lStructSize = LenB(cc)
cc.hwndOwner = Application.hWndAccessApp
cc.lpCustColors = VarPtr(CustomColors(0))
cc.Flags = &H1 Or &H2 ' CC_RGBINIT + CC_FULLOPEN
If ChooseColor(cc) Then
KiesKleur = cc.rgbResult
Else
KiesKleur = -1 ' Geen kleur gekozen
End If
End Function
OM DIT TE TESTEN:
Type in de “Direct sectie” van de “VBA_editor “?KiesKleur()”
ACHTERGRONDKLEUR:
Om toe te passen: Maak knop in formulier "Gebeurtenis bij klikken"
Plaats deze code tussen wat je al geboden wordt voor de achtergrond kleur:
Dim kleur As Long
kleur = KiesKleur()
If kleur <> -1 Then
Me.Section(acDetail).BackColor = kleur
Else
Beep
MsgBox "Geen kleur gekozen."
End If
TEKSTKLEUR:
Note: Forecolor werkt alleen op besturingselementen.
Om Toe te passen maak knop in formulier "gebeurtenis bij klikken"
Plaats deze code tussen wat ja al geboden wordt voor de tekstkleur.
Dim kleur As Long
Dim ctl As Control
kleur = KiesKleur()
If kleur <> -1 Then
' Pas kleur toe op txtNaam (optioneel, als je dit veld expliciet wilt aanpassen)
Me.Id.ForeColor = kleur
' Pas kleur toe op alle besturingselementen in de Detail-sectie
For Each ctl In Me.Controls
If ctl.Section = acDetail Then
On Error Resume Next
ctl.ForeColor = kleur
On Error GoTo 0
End If
Next ctl
Else
MsgBox "Geen kleur gekozen."
End If
(Optionee) Bij mij is in het toe te passen formulier is het eerste veld ME.ID.Forecolor = Kleur
Met dit toe te passen heb ik legio regels code en tabellen verwijderd, nogmaals dank aan Copilot.
Door mij Typfouten daargelaten.
MVG, John vd V.
