请问vba 控件设置的png背景图怎么没有透明度

淡淡的邪

1. Option Explicit
   
2. Private Type GUID
   
3.     Data1                   As Long
   
4.     Data2                   As Integer
   
5.     Data3                   As Integer
   
6.     Data4(0 To 7)           As Byte
   
7. End Type
   
8. 
   
9. Private Type PICTDESC
   
10.     Size                        As Long
    
11.     Type                        As Long
    
12.     hPic                        As LongPtr
    
13.     hPal                        As LongPtr
    
14. End Type
    
15. 
    
16. Private Type GdiplusStartupInput
    
17.     GdiplusVersion              As Long
    
18.     DebugEventCallback          As LongPtr
    
19.     SuppressBackgroundThread    As Long
    
20.     SuppressExternalCodecs      As Long
    
21. End Type
    
22. 
    
23. Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, _
    
24.     inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr
    
25. Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr
    
26. Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, _
    
27.     hbmReturn As LongPtr, ByVal background As Long) As LongPtr
    
28. Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
    
29. Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
    
30. '原版为olepro32.dll
    
31. Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, _
    
32.     RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
    
33. 
    
34. Public Function LoadImage(ByVal strFName As String) As IPicture
    
35.     Dim uGdiInput As GdiplusStartupInput
    
36.     Dim hGdiPlus As LongPtr
    
37.     Dim hGdiImage As LongPtr
    
38.     Dim hBitmap As LongPtr
    
39. 
    
40.     uGdiInput.GdiplusVersion = 1
    
41.    
    
42.     If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
    
43.         If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
    
44.             GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
    
45.             Set LoadImage = ConvertToIPicture(hBitmap)
    
46.             GdipDisposeImage hGdiImage
    
47.         End If
    
48.         GdiplusShutdown hGdiPlus
    
49.     End If
    
50. 
    
51. End Function
    
52. 
    
53. Public Function ConvertToIPicture(ByVal hPic As LongPtr) As IPicture
    
54. 
    
55.     Dim uPicInfo As PICTDESC
    
56.     Dim IID_IDispatch As GUID
    
57.     Dim IPic As IPicture
    
58. 
    
59.     Const PICTYPE_BITMAP = 1
    
60. 
    
61.     With IID_IDispatch
    
62.         .Data1 = &H7BF80980
    
63.         .Data2 = &HBF32
    
64.         .Data3 = &H101A
    
65.         .Data4(0) = &H8B
    
66.         .Data4(1) = &HBB
    
67.         .Data4(2) = &H0
    
68.         .Data4(3) = &HAA
    
69.         .Data4(4) = &H0
    
70.         .Data4(5) = &H30
    
71.         .Data4(6) = &HC
    
72.         .Data4(7) = &HAB
    
73.     End With
    
74. 
    
75.     With uPicInfo
    
76.         .Size = Len(uPicInfo)
    
77.         .Type = PICTYPE_BITMAP
    
78.         .hPic = hPic
    
79.         .hPal = 0
    
80.     End With
    
81. 
    
82.     OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
    
83. 
    
84.     Set ConvertToIPicture = IPic
    
85. End Function

复制代码

64位的excel206
用LoadImage() 设置的图片 png图片本身是半透明的
    Me.Label22.Picture = LoadImage("D:\学习\Excel\图片素材\bgblk2.png")
    Me.Label21.Picture = LoadImage("D:\学习\Excel\图片素材\BGblk.png")
    Me.Picture = LoadImage("D:\学习\Excel\图片素材\bg2.jpg")

能载入图片，但是png没有透明的。请高手帮忙看看要怎么样才会有透明度，谢谢了请问这个GDIplus有png透明的属性或方法吗？谢谢各位大哥
要是“hhzjxss”大大能看到，并帮忙说说就好了

爱疯

图像控件 | Microsoft Docs
https://docs.microsoft.com/zh-cn ... -help/image-control


搜的，应该是不支持吧。

淡淡的邪

爱疯 发表于 2019-4-27 08:51
图像控件 | Microsoft Docs
https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-inter ...

谢谢您的回复