工作表动态控件如何刷新赋给变量

aman1516

如题，在工作表中动态生成一Image控件，并LoadPicture加载图片，
在同一过程中将其以对象方式赋给一变量，例如将Image控件本身导出为图片时，导出图片为空白控件，
但单独另一个过程（原过程调用也不行）执行导出的话，则无此问题；
请教一下，如何对动态控件进行刷新，一步到位使其赋给变量的是一个已带图片的Image？
详见附件：
工作表动态控件如何刷新赋给变量.rar (1.24 MB, 下载次数: 13)

2024-10-17 01:12 上传

点击文件名下载附件

lss001

'以下把注释全部清除，以免产生误导
Sub shpImg()
    Dim sht As Worksheet, shp As Shape
    Dim Apath As String
    Dim imgCont As Object

    Apath = ThisWorkbook.Path & "\BliT.bmp"
    Set sht = ActiveSheet
    Call delshp
    ActiveWindow.DisplayGridlines = False
    Set imgCont = sht.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=60, Top:=60, Width:=400, Height:=300)
    With imgCont
         .Object.BorderStyle = fmBorderStyleNone
         .Object.PictureSizeMode = fmPictureSizeModeClip
         .Object.PictureAlignment = fmPictureAlignmentCenter
         .Object.Picture = LoadPicture(Apath)
         .Visible = True
         .Locked = True
    End With
   
    t = Timer
    While Timer < t + 2: VBA.DoEvents: Wend
    imgCont.Select
    'Selection.CopyPicture
    Selection.Copy
   
    Dim shp1 As Shape
    Set shp1 = sht.Shapes(1)
    With sht.ChartObjects.Add(0, 0, shp1.Width, shp1.Height).Chart
         .Parent.Select
         .Paste
         .Export ThisWorkbook.Path & "\dImg.jpg", "JPG"
         .Parent.Delete
    End With
   
    MsgBox "ok!"
End Sub

Sub delshp()
Dim shp As Shape
On Error Resume Next
For Each shp In ActiveSheet.Shapes
    shp.Delete
Next
End Sub

大灰狼1976

ActiveX控件导出图片文件直接用
SavePicture .Object.Picture, filepath
就行了呀，不需要用chart转换
我测试正常。

大灰狼1976

我可能理解错了，你要的是控件整体的图片

aman1516

lss001 发表于 2024-10-17 08:56
Sub shpImg()
    Dim sht As Worksheet, shp As Shape
    Dim Apath As String

原来得重新选择，但仍不明我原来代码分开两个过程单独执行也是可以的，call却不行。
不知控件的“刷新”，或属性变更后，是在哪个代码时间点完成的（方可传递）

aman1516

大灰狼1976 发表于 2024-10-17 09:57
我可能理解错了，你要的是控件整体的图片

是的，是将控件整体作为一个图片

lss001

一般情况下不建议使用阻塞式延时

lss001

…...…………

chenjx80

这是我以前的解决方案：

1. ...
   
2. .Object.Picture = LoadPicture(imgPath)
   
3. Delay 16  ' 调用足够多的DoEvents
   
4. ...
   
5. 
   
6. Private Sub Delay(times As Long)
   
7.    Dim i As Long
   
8.    
   
9.    For i = 1 To times
   
10.       DoEvents
    
11.    Next
    
12. End Sub

复制代码

aman1516

chenjx80 发表于 2024-10-17 12:29
这是我以前的解决方案：

不错！
是否可以理解成某种形式的“多线程”尽量放开后台操作...