VBA用户窗体图像在计算机之间大小不同或失真_Vba_Powerpoint

VBA用户窗体图像在计算机之间大小不同或失真

vba

VBA用户窗体图像在计算机之间大小不同或失真,vba,powerpoint,Vba,Powerpoint,我使用图像作为VBA用户窗体上的按钮。这在一台计算机上运行良好，但当我在另一台计算机上查看相同的用户表单时，图像显示不正确如果我将图像的PictureSizeMode设置为fmPictureSizeModeClip，则它对于第二台计算机上的图像区域来说太大，并且图像被剪裁。如果我将PictureSizeMode设置为fmPictureSizeModeZoom，它可以正确缩放第二台计算机上的图像区域，但会丢失很多逼真度（看起来很糟糕）。在这两种情况下，第一台计算机上的图像都很好图像的原始图像格

我使用图像作为VBA用户窗体上的按钮。这在一台计算机上运行良好，但当我在另一台计算机上查看相同的用户表单时，图像显示不正确

如果我将图像的PictureSizeMode设置为fmPictureSizeModeClip，则它对于第二台计算机上的图像区域来说太大，并且图像被剪裁。如果我将PictureSizeMode设置为fmPictureSizeModeZoom，它可以正确缩放第二台计算机上的图像区域，但会丢失很多逼真度（看起来很糟糕）。在这两种情况下，第一台计算机上的图像都很好

图像的原始图像格式为jpg

我试着在我开发代码的计算机和出现问题的第二台计算机上更改屏幕分辨率。我无法用这种方式在第一台计算机上重现这个问题（我还有一个古老的显示器连接到它，它也显示得很好）。通过这样做，我也无法在第二台计算机上解决问题

以下是VBE中所选图像的屏幕截图：

在第一台显示正确的计算机上（无论设置为剪辑模式还是缩放模式，看起来都一样）：

在第二台计算机上-PictureSizeMode设置为fmPictureSizeModeClip：和PictureSizeMode设置为fmPictureSizeModeZoom：

我发现没有办法令人满意地调整图片的大小，使它们始终在不同的机器上显示，因此我提出的解决方案是调整图片周围表单的其余部分的大小

为此：

将图像的PictureSizeMode设置为fmPictureSizeModeClip
在机器上正确测量表单中一个图像的高度或宽度（以点为单位）
根据此图像的尺寸变化设置窗体和控件的尺寸

专用子窗体大小（） Dim DBLDEFULTERIMAGEHEIGHT为双精度 '这是在上计算的参考图像的高度 '看起来合适的机器： dblDefaultRefImageHeight=1947 Dim dblActualRefImageHeight为双精度 dblActualRefImageHeight=Me.ImgRefImage.Picture.Height Dim dblSizeFactor为双精度 dblSizeFactor=dblActualRefImageHeight/DBLDEFAULTREIMAGEHEIGHT Me.Height=Me.Height*dblSizeFactor Me.Width=Me.Width*dblSizeFactor 作为控件的Dim CTL控件对于Me.Controls中的每个控件 ctlControl.Top=ctlControl.Top*dblSizeFactor ctlControl.Left=ctlControl.Left*dblSizeFactor ctlControl.Height=ctlControl.Height*dblSizeFactor ctlControl.Width=ctlControl.Width*dblSizeFactor 如果TypeName（ctlControl）=“标签”，则 ctlControl.Font.Size=ctlControl.Font.Size*dblSizeFactor 如果结束下一个CTL控件端接头

将其放入userform中，并在创建表单时调用它-例如，从userform_Initialize（）。

我发现没有办法令人满意地调整图片的大小，以便它们总是在不同的机器上显示，因此我提出的解决方案是围绕图片调整表单其余部分的大小

为此：

将图像的PictureSizeMode设置为fmPictureSizeModeClip
在机器上正确测量表单中一个图像的高度或宽度（以点为单位）
根据此图像的尺寸变化设置窗体和控件的尺寸

将其放入userform中，并在创建表单时调用它-例如，从userform_Initialize（）。

您的PowerPoint版本是什么？您是否可能在Windows和Mac计算机之间移动此文件？它都是Windows（不涉及Mac）。PowerPoint版本：在两台计算机上运行Office 365版本1906（Build 11727.20210 Click to Run）。此外，在第一台计算机上的虚拟机（VirtualBox中的Windows 10，相同的Office版本）上运行PowerPoint存在相同的用户表单映像问题。这两台计算机上的dpi设置如何？相同或不同？您的PowerPoint版本是什么？您是否可能在Windows和Mac计算机之间移动此版本？它都是Windows（不涉及Mac）。PowerPoint版本：在两台计算机上运行Office 365版本1906（Build 11727.20210 Click to Run）。此外，在第一台计算机上的虚拟机（VirtualBox中的Windows 10，相同的Office版本）上运行PowerPoint存在相同的用户表单映像问题。这两台计算机上的dpi设置如何？相同还是不同？ Private Sub AdjustFormSize() Dim dblDefaultRefImageHeight As Double ' This is the height of the reference image as computed on the ' machine where it looks right: dblDefaultRefImageHeight = 1947 Dim dblActualRefImageHeight As Double dblActualRefImageHeight = Me.ImgRefImage.Picture.Height Dim dblSizeFactor As Double dblSizeFactor = dblActualRefImageHeight / dblDefaultRefImageHeight Me.Height = Me.Height * dblSizeFactor Me.Width = Me.Width * dblSizeFactor Dim ctlControl As Control For Each ctlControl In Me.Controls ctlControl.Top = ctlControl.Top * dblSizeFactor ctlControl.Left = ctlControl.Left * dblSizeFactor ctlControl.Height = ctlControl.Height * dblSizeFactor ctlControl.Width = ctlControl.Width * dblSizeFactor If TypeName(ctlControl) = "Label" Then ctlControl.Font.Size = ctlControl.Font.Size * dblSizeFactor End If Next ctlControl End Sub