Прескочи на основното съдържание

Как да вмъкна картина в текстово поле?

Автор: Xiaoyang Последна промяна: 2021-01-08

По подразбиране можем да вмъкнем картина или изображение в работен лист толкова бързо, като използваме функцията Вмъкване, но тази функция не се прилага за вмъкване на картина в текстово поле. С тази статия мога да ви помогна да вмъкнете картина в текстово поле, както ви е необходимо.

Вмъкнете картина или изображение в текстово поле с VBA код


стрелка син десен балон Вмъкнете картина или изображение в текстово поле с VBA код

За да вмъкнете картина в текстово поле, следният VBA код може да ви помогне, моля, направете следното:

1. Вмъкнете текстово поле, като щракнете Поставете > Text Boxи след това нарисувайте текстово поле, вижте екранната снимка:

doc вмъкнете изображение в текстово поле 1

2. След това задръжте натиснат ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

3. Щракнете Поставете > Модулии поставете следния код в Модули Window.

VBA код: Вмъкнете картина в текстовото поле:

Sub ShapePicture()
    Dim xSh As Shape
    Dim xPic As IPictureDisp
    Dim xFileName As String
    xFileName = "C:\Users\DT168\Desktop\pictures\Apple.JPG"
    Set xPic = LoadPicture(xFileName)
    Set xSh = Sheets("Sheet4").Shapes(1)
    xSh.Height = xPic.Height / xPic.Width * xSh.Width
    Set xPic = LoadPicture("")
    Set xPic = Nothing
    xSh.Fill.UserPicture xFileName
End Sub

Забележка: В горния код, Sheet4 е името на листа, който съдържа текстовото поле, в което искате да вмъкнете картина, и C:\Users\DT168\Desktop\pictures\Apple.JPG е пътя на картината на картината, която искате да вмъкнете, трябва да ги промените според вашите нужди.

4. И след това натиснете F5 за стартиране на този код, конкретното изображение ще бъде вмъкнато в текстовото поле наведнъж и можете да редактирате текстовото поле, както ви е необходимо, вижте екранната снимка:

doc вмъкнете изображение в текстово поле 2


Още по темата:

Как да задам стойност по подразбиране в текстово поле?

Как да разрешите въвеждането само на числа в текстовото поле?

Как да приложа проверка на правописа в текстовото поле?

Как да променя цвета на текстовото поле въз основа на стойност в Excel?

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии    VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар    Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки    Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание


Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
Comments (6)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Yes, I changed both. I did not get any errors when I ran the macro using the F5 key.

I tried to place the macro in different folders of the workbook, worksheet, module,class module but the results were the same: no picture in the text box.


Thanks for writing back. The last name is Hecker, BTW....typo
This comment was minimized by the moderator on the site
Tried this macro on Excel 365. It did not work. Did not receive error message. Macro ran to completion. Picture is not shown in textbox.
This comment was minimized by the moderator on the site
Hello,harvey,
Do you change the sheet name and picture path to your own in the code? Please chek it, thank you!

Note: In the above code, Sheet4 is the sheet name which contains the text box you want to insert picture, and C:\Users\DT168\Desktop\pictures\Apple.JPG is the picture path of the picture you want to insert, you should change them to your need.
This comment was minimized by the moderator on the site
Hi Sky
I have changed the sheet name and the path of the picture. But it still doesn't work.

I got bugs here in "xSh.Fill.UserPicture xFileName"

Many thanks.
Meg
This comment was minimized by the moderator on the site
Hello, Meg,
The code in this article may work well for some simple name picture.
If your picture name is complex, you should apply the below code:
Note: Please change the Text Box 1 to your own name of the textbox.
Sub InsertPicture()
    Dim sPicture As String, pic As Picture
    Dim shp As Shape, shps As ShapeRange  
    sPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp; *.tif;*.png), *.gif; *.jpg; *.bmp; *.tif; *.png", _
        , "Select Picture to Import") 
    If sPicture = "False" Then Exit Sub   
    Set shp = ActiveSheet.Shapes("Text Box 1")
    Set pic = ActiveSheet.Pictures.Insert(sPicture)
    With pic
        .Name = "My Picture"
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = shp.Height
        .Width = shp.Width
        .Top = shp.Top
        .Left = shp.Left
        .Placement = xlMoveAndSize
    End With
    Set shps = ActiveSheet.Shapes.Range(Array("Text Box 1", "My Picture"))
    shps.Group
    shps.Name = "Pic inside text box"    
    Set pic = Nothing
End Sub


Please have a try, hope it can help you!
If you have any other problem, please comment here.
This comment was minimized by the moderator on the site
It work perfectly. Only change the Text box name as shown:
Set xSh = Sheets("Sheet1").Shapes("TextBox 2")
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations