自己写的凑和用吧
Public Function ApplyTheme(Object As Object)
On Error Resume Next
Dim HexRGB As String
If Object Is Nothing Then Exit Function
HexRGB = GetParameter("Theme Color", dbText, "")
If HexRGB = "" Then
HexRGB = "EDEDED"
ElseIf Left(HexRGB, 1) = "#" Then
HexRGB = Mid(HexRGB, 2)
Else
HexRGB = hex(HexRGB)
End If
'HexRGB = Mid(GetParameter("Theme Color", dbText, "#EDEDED"), 2)
Select Case Len(HexRGB)
Case Is > 6
Err.Raise 6
'GoTo Error_MyHexidecimal_BeforeUpdate
Case 1
HexRGB = "00000" & HexRGB
Case 2
HexRGB = "0000" & HexRGB
Case 3
HexRGB = "000" & HexRGB
Case 4
HexRGB = "00" & HexRGB
Case 5
HexRGB = "0" & HexRGB
End Select
strBackColor = Val("&H" & HexRGB & "&")
Object.Section(acDetail).Properties("BackColor") = strBackColor
If Object.Section(acHeader).Visible Then Object.Section(acHeader).Properties("BackColor") = strBackColor
If Object.Section(acFooter).Visible Then Object.Section(acFooter).Properties("BackColor") = strBackColor
If Object.Section(acPageHeader).Visible Then Object.Section(acPageHeader).Properties("BackColor") = strBackColor
If Object.Section(acPageFooter).Visible Then Object.Section(acPageFooter).Properties("BackColor") = strBackColor
End Function
