将文本框内容保存为图像文件

Question

虽然我找到了一种将位于工作表中的文本框的内容保存为图像文件（png、bmp、jpeg）的方法，但我无法为位于用户窗体中的文本框实现相同的功能。 附加代码返回一张空白图片。 请有人指出我正确的方向吗？

Private Sub CommandButton1_Click()
' save textbox content as image file
    Dim cht As ChartObject
    Dim ActiveShape As Shape
    
    TextBox1.Text = "12345"
    ' select the TextBox
    TextBox1.SetFocus
    ' Copy selection
    Selection.Copy
    '
    Application.ScreenUpdating = False
    Worksheets("Sheet1").Activate
    
    ' paste selection into a picture shape
    ActiveSheet.Pictures.Paste(link:=False).Select
    Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
    ' Create temporary chart object (same size as shape)
    Set cht = ActiveSheet.ChartObjects.Add(Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, Top:=ActiveCell.Top, Height:=ActiveShape.Height)
    ' Format temporary chart to have a transparent background
    cht.ShapeRange.Fill.Visible = msoFalse
    cht.ShapeRange.Line.Visible = msoFalse
    ' Copy/Paste Shape inside temporary chart
    ActiveShape.Copy
    cht.Activate
    ActiveChart.Paste
    'Save chart to User's Desktop as image file
     cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & "TextBoxImage" & ".bmp"
    'Delete temporary Chart
    cht.Delete
    ActiveShape.Delete

    Application.ScreenUpdating = True
End Sub

Answer 1

恐怕用户表单文本框没有必要的CopyPicture 属性。即使是工作表 ActiveX 文本框，Copy 也不会返回对象图片...

所以，你可以完成你想要的，只使用一个技巧：在工作表上创建这样一个文本框克隆并使用它来导出图片：

Private Sub CommandButton1_Click()
  Dim ob As OLEObject, sh As Worksheet, tb As msforms.TextBox, ch As ChartObject, pictName As String

  Set sh = ActiveSheet
  pictName = ThisWorkbook.path & "\TextBoxImage.jpg"
    Set ob = sh.OLEObjects.Add(ClassType:="Forms.TextBox.1", link:=False, _
        DisplayAsIcon:=False, left:=383.4, top:=29.4, width:=Me.TextBox1.width, height:=Me.TextBox1.height)
    Set tb = ob.Object
    DoEvents
    With tb
        .Text = Me.TextBox1.Text
        .BackColor = Me.TextBox1.BackColor
        .ForeColor = Me.TextBox1.ForeColor
        .Font = Me.TextBox1.Font
        .Font.Size = Me.TextBox1.Font.Size
    End With
    DoEvents
    Set ch = sh.ChartObjects.Add(left:=1, _
       top:=1, width:=tb.width, height:=tb.height)

       tb.CopyPicture: ch.Activate: ActiveChart.Paste
       ch.Chart.Export pictName, "JPEG"
      ch.Delete
      ob.Delete
End Sub

如有必要，可以以相同的方式复制其他一些文本框属性（粗体、斜体等）。

请进行测试并发送一些反馈。