Přejít k hlavnímu obsahu

Jak vložit obrázek do textového pole?

Ve výchozím nastavení můžeme obrázek nebo obrázek vložit do listu tak rychle pomocí funkce Vložit, ale tato funkce se nepoužije na vložení obrázku do textového pole. V tomto článku vám mohu pomoci podle potřeby vložit obrázek do textového pole.

Vložte obrázek nebo obrázek do textového pole s kódem VBA

šipka modrá pravá bublina Vložte obrázek nebo obrázek do textového pole s kódem VBA

Chcete-li vložit obrázek do textového pole, může vám pomoci následující kód VBA, postupujte takto:

1. Vložte textové pole kliknutím Vložit > Text Boxa potom nakreslete textové pole, viz screenshot:

doc vložte obrázek do textového pole 1

2. Poté přidržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

3, klikněte Vložit > Modula vložte následující kód do Modul Okno.

Kód VBA: Vložte obrázek do textového pole:

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

Poznámka: Ve výše uvedeném kódu, Sheet4 je název listu, který obsahuje textové pole, do kterého chcete vložit obrázek, a C: \ Users \ DT168 \ Desktop \ obrázky \ Apple.JPG je cesta k obrázku, který chcete vložit, měli byste je podle potřeby změnit.

4. A pak stiskněte F5 klíč ke spuštění tohoto kódu, konkrétní obrázek se vloží do textového pole najednou a textové pole můžete upravit podle potřeby, viz screenshot:

doc vložte obrázek do textového pole 2

Související články:

Jak nastavit výchozí hodnotu v textovém poli?

Jak povolit zadávání pouze čísel do textového pole?

Jak použít kontrolu pravopisu v textovém poli?

Jak změnit barvu textového pole na základě hodnoty v aplikaci Excel?

Nejlepší nástroje pro produktivitu v kanceláři

Populární funkce: Najít, zvýraznit nebo identifikovat duplikáty   |  Odstranit prázdné řádky   |  Kombinujte sloupce nebo buňky bez ztráty dat   |   Kolo bez vzorce ...
Super vyhledávání: Více kritérií VLookup  |   VLookup s více hodnotami  |   VLookup na více listech   |   Fuzzy vyhledávání ....
Pokročilý rozevírací seznam: Rychle vytvořte rozevírací seznam   |  Závislý rozbalovací seznam   |  Vícenásobný výběr rozevíracího seznamu ....
Správce sloupců: Přidejte konkrétní počet sloupců  |  Přesunout sloupce  |  Přepnout stav viditelnosti skrytých sloupců  |  Porovnejte rozsahy a sloupce ...
Doporučené funkce: Zaměření mřížky   |  Návrhové zobrazení   |   Velký Formula Bar   |  Správce sešitů a listů   |  Knihovna zdrojů (Automatický text)   |  Výběr data   |  Zkombinujte pracovní listy   |  Šifrovat/dešifrovat buňky   |  Odesílat e-maily podle seznamu   |  Super filtr   |   Speciální filtr (filtr tučné/kurzíva/přeškrtnuté...) ...
Top 15 sad nástrojů:  12 Text Tools (doplnit text, Odebrat znaky, ...)   |   50 + Graf Typ nemovitosti (Ganttův diagram, ...)   |   40+ Praktické Vzorce (Vypočítejte věk na základě narozenin, ...)   |   19 Vložení Tools (Vložte QR kód, Vložit obrázek z cesty, ...)   |   12 Konverze Tools (Čísla na slova, Přepočet měny, ...)   |   7 Sloučit a rozdělit Tools (Pokročilé kombinování řádků, Rozdělit buňky, ...)   |   ... a více

Rozšiřte své excelentní dovednosti pomocí Kutools for Excela zažijte efektivitu jako nikdy předtím. Kutools for Excel Nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času.  Kliknutím sem získáte funkci, kterou nejvíce potřebujete...

karta kte 201905

Office Tab Přináší rozhraní s kartami do Office a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
Comments (6)
No ratings yet. Be the first to rate!
Harvey Hecker
Harvey Hecker
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
Reply
0
0
harvey heckef
harvey heckef
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.
Reply
0
0
skyyang
skyyang     harvey heckef
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.
Reply
Report
0
0
Meg
Meg     skyyang
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
Reply
0
0
skyyang
skyyang     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.
Reply
Report
0
0
Alex Pineda
Alex Pineda     skyyang
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")
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations