MS Access 2010通过VBA更改主题

Question

我曾希望在MS Access 2010数据库中制作一个简单的表单，用户可以在其中选择要使用的主题。你如何通过vba更改数据库的主题？ Google对这个问题没有太大的帮助。

Answer 1

我知道这个问题前一段时间被问到，但由于我在研究设置主题时遇到了它，我以为我应该尝试提供一些我发现的内容。

当谈到让用户选择主题时，我认为最简单的方法就是将“颜色”按钮放入功能区。如果您碰巧制作了自己的自定义功能区，则可以使用<control idMso="ThemeColorsGallery" />来引用“颜色”选项。

如果你想尝试对发生的事情有更精确的控制，我想我可能已经找到了一个选择，但是它有点牵扯，我还没有弄清楚细节。不过，我想发布它，因为我认为有人可能想要使用它。

在控制图像库功能时，我意识到隐藏的“MSysResources”表中有一个“Office主题”条目。我相信“MySysResources”表中的“Office主题”行中的任何内容都决定了程序启动时加载的主题。我测试这个想法的方式是我选择了一个主题，然后到桌面并将附件保存到桌面。然后，我去了，选择了一个不同的主题，并通过查看我的一些表格来确保它已经到位。然后，我回到桌子上，删除“Office Theme”行中的内容，并将保存的文件上传回附件。关闭并重新打开程序后，我保存到桌面上，然后重新加载到当前主题顶部的主题是正在使用的主题。

我想这可能会被使用的方式是，您可以通过代码分配该附件。特别是，如果您想根据特定于您的程序的配置选项覆盖默认设置，那么看起来好像它可能很有用。

更新15年8月18日： 有人要求了解我是如何能够通过VBA来设置我的主题额外的细节，所以我会在这里为他们提供。基本理论是我将MSysResources附件字段中的数据保存到表中。然后，如果我需要用保存的主题覆盖当前主题，则从我的表中提取它并将其保存在适当的MSysResources记录中。请注意，我使用MySQL作为我的表格存储平台，并使用名为“Lgo”的MediumBlob字段来存储数据。

以下是我使用的两个功能。第一个函数将主题保存到我的MySQL表中。第二个函数提取保存的数据并将其保存在MSysResourcestable中当前主题的顶部。请注意，要查看第二个功能的效果，您必须在运行该功能后关闭并重新打开您的程序。

Function SveThm()'Save Theme 
    Dim MSR As Recordset, Atc As Recordset, LR As Recordset 
    Set MSR = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset) 
    If MSR.RecordCount > 0 Then 
     Set Atc = MSR!Data.Value 
     Set LR = CurrentDb.OpenRecordset("SELECT * FROM tbllgo;", dbOpenDynaset) 
     If LR.RecordCount = 0 Then LR.AddNew Else LR.Edit 
     LR!Stn = LgoStn 
     LR!Lgo = CStr(Atc!FileData) 
     LR!Typ = Typ 
     LR.Update 
     LR.Close 
     MsgBox "Your theme has been saved." 
    End If 
End Function 

Function SetMSys()'Set MSysResources 
    Dim MSys As Recordset, Lgo As Recordset, Atc As Recordset 
    Set MSys = CurrentDb.OpenRecordset("SELECT * FROM MSysResources WHERE [Name]='Office Theme'", dbOpenDynaset) 
    If MSys.RecordCount > 0 Then 
     MSys.Edit 
     Set Atc = MSys!Data.Value 
     Atc.Edit 
     Set Lgo = CurrentDb.OpenRecordset("SELECT Lgo FROM tbllgo;", dbOpenDynaset) 
     If Lgo.RecordCount > 0 Then Atc!FileData = Lgo!Lgo 
     Lgo.Close 
     Atc.Update 
     MSys.Update 
    End If 
End Function