Сохранение содержимого текстового поля в виде файла изображения

avatar
F Home
8 августа 2021 в 17:18
114
1
0

Хотя я нашел способ сохранить содержимое текстового поля, расположенного на листе, в виде файла изображения (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
Источник

Ответы (1)

avatar
FaneDuru
8 августа 2021 в 18:39
0

Боюсь, что текстовое поле пользовательской формы не имеет необходимого свойства 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

При необходимости некоторые другие свойства текстового поля могут быть скопированы таким же образом (жирный шрифт, курсив и т.д.).

Пожалуйста, протестируйте его и отправьте отзыв.

FaneDuru
8 августа 2021 в 20:06
0

@F Home Вы не нашли время, чтобы протестировать приведенный выше код? Если протестировано, разве это не то, что вам нужно?