如何在 PowerPoint 中从 LoadImage() 中指定宽度和高度

Question

我在宏中使用 LoadPicture 方法来加载 jpg 图像。我想知道它的宽度和高度，但我得到的值没有用。我尝试在一些论坛中找到解决方案，我看到了这个解决方案：

Set oBmp = LoadPicture(FileName)
Hght = ScaleX(oBmp.Width, vbHimetric, vbPixels)
Wdth = ScaleY(oBmp.Height, vbHimetric, vbPixels)

问题是在 powerpoint ScaleX 和 ScaleY 不工作。至少在我的 powerpoint 中给了我编译错误：找不到方法或数据成员。

我也在尝试这种代码的和平：

Dim myPic As IPictureDisp

Set myPic = LoadPicture("C:\dink_template\dinkFile\sizeimage.jpg")
Hght = myPic.height
wid = myPic.width

我检查了图像，他的像素大小是高度 = 132 像素和宽度 = 338 像素，但我得到高度 = 2794 和宽度 7154

如何在 powerpoint 中使用 ScaleX/ScaleY？或者如果我不能使用它们如何将值传递给像素？

Answer 1

这相当棘手。您从.Width 和.Height 属性收到的尺寸实际上是OLE_YSIZE_HMETRIC/OLE_XSIZE_HMETRIC，据我所知，这是一个代表0.01mm 的测量增量。

我最初并没有看到任何简单的解决方法，（公式或至少是一个有用的 WinAPI 函数）。

这应该适用于大多数具有正常/默认屏幕分辨率设置的用户

函数使用后期绑定/不需要对 Publisher 的引用，尽管该库仍然需要在用户的机器上可用。

Option Explicit
Sub Test()
    Dim filepath$
    filePath = "C:\image_file.JPG"
    MsgBox "Height = " & GetImageDimensions(filepath)(0) & vbNewLine & _
        "Width = " & GetImageDimensions(filepath)(1), vbOKOnly, "Dimensions"
End Sub

   Function GetImageDimensions(filepath) As Variant
    'Function returns an array of (Height, Width) from a specific image file path
    '
    Dim tmp(0 To 1) As Long
    Dim oPub As Object
    Set oPub = CreateObject("Publisher.Application")
    'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
    ' these are representing 0.01 mm
    With LoadPicture(filepath)
    'Multiply by 0.01 to get dimension in millimeters, then
    ' use the MS Publisher functions to convert millimeters -> points -> pixels
        tmp(0) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Height))
        tmp(1) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Width))
    End With
    GetImageDimensions = tmp

    End Function

这是一个测试用例：

结果如下：

评论更新

我在调试时得到以下尺寸：

• .Height = 3493
• .Width = 8943

但是，您表示您分别得到 2794 和 7154。

我可以在更改屏幕分辨率（例如 125%）时复制您的结果。下面的方法应该可以解决这种差异。

尝试使用 WinAPI 来（希望）解决我们得到的任何差异（像素大小，可能在您的计算机上有所不同，这可能会导致这种情况，尽管我希望 Publisher 函数会解决这个问题...... )

这个带有 WinAPI 调用的函数应该适用于所有用户，无论分辨率如何

Function GetImageDimensions2(filePath As String) As Variant
'Function returns an array of (Height, Width) from a specific image file path
Dim tmp(0 To 1) As Long
'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
' these are representing 0.01 mm
With LoadPicture(filePath)
    tmp(0) = .Height / 2540 * (1440 / TwipsPerPixelY())
    tmp(1) = .Width / 2540 * (1440 / TwipsPerPixelX()) 
End With
GetImageDimensions2 = tmp
End Function

并将这些 WinAPI 调用包含在另一个模块中：

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
  ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function TwipsPerPixelX() As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
  Dim lngDC As Long
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
  ReleaseDC HWND_DESKTOP, lngDC
End Function

'--------------------------------------------------
Function TwipsPerPixelY() As Single
'--------------------------------------------------
'Returns the height of a pixel, in twips.
'--------------------------------------------------
  Dim lngDC As Long
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
  ReleaseDC HWND_DESKTOP, lngDC
End Function