在 ms 访问中创建独立于分辨率的表单

Question

我的表格设计为 1280*1024 分辨率。它们在我的显示器上看起来非常漂亮，但如果我在其他显示器上看到，它们看起来非常混乱。有没有办法解决这个问题？

Answer 1

这并不容易。这就是 MVC 非常方便的地方，您可以区分不同的组件。对于不同的设备，您可以有不同的视图。不幸的是，VBA 不支持这一点，您必须实现自己的框架来处理不同的屏幕分辨率。

避免重新实现用户窗体设计的最简单方法是在编写一行代码之前在脑海中实际设计它。想想您的软件将支持的不同分辨率（设备）、您使用的语言支持什么以及您的选择是什么。一般来说，三思而后行。在 VBA 中，我通常只选择默认大小，以避免因适合其他人的屏幕而头疼。

您将不得不重新设计整个用户窗体。不是视觉上的，而是以编程方式设置用户窗体的width, and height 并使控件依赖于当前分辨率。我不建议这样做，但这仍然是一个解决方案。

您可以通过访问当前分辨率并修改您的 Userform_Initialize() 事件来实现。

例如，如果当前分辨率为 1024x768，则将 width 和 height 设置为 currentWidth-100px 和 currentHeight-100px。

如果您打开一个新工作簿并创建一个空的用户窗体。转到它后面的代码并添加

Private Sub UserForm_Initialize()

    Me.Width = GetCurrent(0) - 600
    Me.Height = GetCurrent(1) - 800

End Sub

然后插入一个模块并添加

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Sub A()

    UserForm1.Show
    Unload UserForm1

End Sub

Function GetCurrent(x As Long) As Long
    GetCurrent = GetSystemMetrics(x)
End Function

这将根据当前分辨率显示不同大小的用户窗体。

您可以（但我不推荐）使用该技术。注意：根据您拥有的控件数量，这可能是最好的方法，但如果您在用户窗体上有很多控件，我会寻找替代方法。

---

或者，您可以使用以下代码检查当前屏幕分辨率，警告用户并询问用户是否要更改其分辨率。

以下代码来自here，原作者为DRJ

你把第一部分粘在 Workbook 代码后面

Option Explicit 

Private Sub Workbook_Open() 

    Call VerifyScreenResolution 

End Sub 

以及模块中的以下部分

Option Explicit 

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long 
Const SM_CXSCREEN = 0 
Const SM_CYSCREEN = 1 

Sub VerifyScreenResolution(Optional Dummy As Integer) 

    Dim x  As Long 
    Dim y  As Long 
    Dim MyMessage As String 
    Dim MyResponse As VbMsgBoxResult 

    x = GetSystemMetrics(SM_CXSCREEN) 
    y = GetSystemMetrics(SM_CYSCREEN) 
    If x = 1024 And y = 768 Then 
    Else 
        MyMessage = "Your current screen resolution is " & x & " X " & y & vbCrLf & "This program " & _ 
        "was designed to run with a screen resolution of 1024 X 768 and may not function properly " & _ 
        "with your current settings." & vbCrLf & "Would you like to change your screen resolution?" 
        MyResponse = MsgBox(MyMessage, vbExclamation + vbYesNo, "Screen Resolution") 
    End If 
    If MyResponse = vbYes Then 
        Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3") 
    End If 

End Sub 

更新。

你的初始化事件在这里