我有名为的WebBrowser控件WebBrowser1
。
我使用此代码通过其URL显示图像。
WebBrowser1.Navigate ("https://cdn2.iconfinder.com/data/icons/modern-latin-alphabet-lowercase-and-uppercase-lett/154/alphabet-uppercase-letter-z-512.png")
它的效果很好,但是图像比WebBrowser控件大。
因此,我需要调整图像大小以适合WebBrowser控件的大小。
尝试以下代码以适合图像宽度:
Sub Test()
UserForm1.Show
UserForm1.WebBrowser1.Navigate "about:blank"
UserForm1.WebBrowser1.Document.Write "<img style=""width:100%;"" src=""https://cdn2.iconfinder.com/data/icons/modern-latin-alphabet-lowercase-and-uppercase-lett/154/alphabet-uppercase-letter-z-512.png"">"
End Sub
现在,您可能要同时适合图像的高度和宽度,毕竟,object-fit
幸运的是,所有现代浏览器都支持CSS ,IE除外;)因此,要使图像适合视口并保留纵横比,必须找到最小的高度和宽度比例。宽度,并通过将其设置为100%使图像适合该尺寸。可以通过嵌入文档中的CSS或javascript来完成,但是出于VBA的目的,以下代码效果很好。另外,WebBrowser控件的init和单独的过程用于显示定义的图像,从而增加了健壮性。
假设UserForm1
使用WebBrowser控件将ShowModal设置为False。将以下代码放在UserForm模块中:
Private Sub UserForm_Initialize()
With Me.WebBrowser1
.Navigate "about:blank"
.Document.Write "<body style='background-color: buttonface; overflow: hidden;'></body>"
End With
End Sub
Public Sub displayImage(src)
With Me.WebBrowser1
.Document.Close
.Document.Write "<body id='body' style='background-color: buttonface; overflow: hidden; margin: 0; text-align: center;'><img id='img' src='" & src & "'></body>"
Dim img
Set img = .Document.getElementById("img")
Dim body
Set body = .Document.getElementById("body")
If body.ClientHeight / img.ClientHeight < body.ClientWidth / img.ClientWidth Then
img.Style.Height = "100%"
Else
img.Style.Width = "100%"
End If
End With
End Sub
放入Test1
标准模块并调用它以显示图像:
Sub Test1()
UserForm1.Show
UserForm1.displayImage "https://i.stack.imgur.com/B8imb.gif"
End Sub
您也可以将base64编码的图像嵌入到代码中(使用任何在线Base64图像编码器),请参见Test2
示例:
Sub Test2()
UserForm1.Show
UserForm1.displayImage _
"data:image/png;base64," & _
"iVBORw0KGgoAAAANSUhEUgAAAQAAAAEACAYAAABccqhmAAAACXBIWXMAAA7DAAAOwwHHb6hkAAADoklE" & _
"QVR4nO3dwW2DQBBAUYjSaWSKikytTgMcgmS8K/57BaA5fc2BgXV5PF8LkPQ1egBgHAGAMAGAMAGAMAGA" & _
"MAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGA" & _
"MAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAMAGAsO/RA/AZr9+f0SPcyrrto0d4CxsAhAkA" & _
"hAkAhAkAhAkAhAkAhAkAhAkAhAkAhAkAhAkAhLkF4NDV77qfvU2YbZ67sAFAmABAmABAmABAmABAmABA" & _
"mABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmABAmP8CcGi27+TP" & _
"Ns9d2AAgTAAgTAAgTAAgTAAgTAAgTAAgTAAgTAAgTAAgTAAgzC1AxLrto0f4KLcD/2MDgDABgDABgDAB" & _
"gDABgDABgDABgDABgDABgDABgDABgLDb3AJ49/vearcMn2IDgDABgDABgDABgDABgDABgDABgDABgDAB" & _
"gDABgDABgLDb3AKcdfW75WdvE8zDCDYACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMA" & _
"CBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACMv+F2C279KbhxFsABAmABAmABAmABAmABAmABAm" & _
"ABAmABAmABAmABAmABCWvQVYt/3S5599l36meWaahWvZACBMACBMACBMACBMACBMACBMACBMACBMACBM" & _
"ACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACAs+1+A2b5NP9M8M83CtWwAECYA" & _
"ECYAECYAECYAECYAECYAECYAECYAECYAECYAEJa9BZjNuu2XPt/7/RyxAUCYAECYAECYAECYAECYAECY" & _
"AECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECYAECY" & _
"AECYAECYAECYAECYAECYAECYAECYAECYAEDYujyer9FDAGPYACBMACBMACBMACBMACBMACBMACBMACBM" & _
"ACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBMACBM" & _
"ACBMACBMACBMACBMACBMACBMACBMACBMACDsD0NPOfMjSKzzAAAAAElFTkSuQmCC"
End Sub
我发现删除WebBrowser控件下陷边框的最简单方法是...通过将它们移到UserForm边框之外(通过将Top和Left设置为负,Height和Width大于UserForm)来简单地“裁剪”,或在Frame控件中进行相同的操作,其中SpecialEffect设置为0,并且标题为空。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句