1

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

4

1 回答 1

1

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

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

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

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

例如，如果当前分辨率为 1024x768，则将widthand设置height为currentWidth-100pxand 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

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

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

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

以下代码来自这里，原作者是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

更新。

你的初始化事件在这里

在此处输入图像描述

于 2013-09-17T11:01:54.670 回答