excel - 将文本框内容保存为图像文件
问题描述
虽然我找到了一种将位于工作表中的文本框的内容保存为图像文件(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
解决方案
恐怕用户表单文本框没有必要的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
如有必要,可以以相同的方式复制其他一些文本框属性(粗体、斜体等)。
请测试它并发送一些反馈。
推荐阅读
- apache-nifi - 为什么要克隆流文件?
- python - 在 Django 中一段时间后更新模型字段
- excel - 编译 - 语法错误:使用 If 语句切换选择过滤器时
- java - SpringMVC框架原理
- python - 用户如何在 django rest UpdateAPIView 中更新他们的帖子
- android - 从 getParcelableExtra() 接收 null
- c# - CreateDirectory 在公用文件夹中创建重复目录
- events - Tokbox - connectionDestroyed 事件 - 延迟与 networkDisconnected 原因
- python - 在pycharm上设置anaconda python 3.7解释器时出错
- c - 如何在 C++ 中创建多边形 ESRI shapefile?