以ms访问创建分辨率独立表单

Question

我以1280x1024分辨率设计了我的表单。它们在我的显示器上看起来很漂亮，但如果我在另一台显示器上看到，它们看起来非常混乱。有没有办法解决这个问题？

Answer 1

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

避免重新实现用户表单设计的最简单方法是在编写单行代码之前实际设计它。考虑一下您的软件将支持的不同分辨率（设备），您正在使用的语言是什么，以及您的选择是什么。一般来说，考虑一下。在VBA中，我通常会选择默认大小，以避免因为安装某人的其他屏幕而感到头痛。

您必须重新设计整个UserForm。不是直观的，而是以编程方式设置用户表单的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

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

你可以（但我不推荐它）使用这种技术。注意：根据您拥有的控件数量，这可能是最佳方法，但如果您对userform有很多控件，我会寻找替代方案。

---

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

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

您将第一部分放在

后面的工作簿代码中

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 

更新

你的初始化事件就在这里