انتقل إلى المحتوى الرئيسي

كيفية إدراج الصورة في مربع النص؟

بشكل افتراضي ، يمكننا إدراج صورة أو صورة في ورقة العمل بأسرع ما يمكن باستخدام وظيفة الإدراج ، ولكن لا يتم تطبيق هذه الميزة على إدراج صورة في مربع نص. باستخدام هذه المقالة ، يمكنني مساعدتك في إدراج صورة في مربع نص حسب حاجتك.

قم بإدراج صورة أو صورة في مربع نص برمز VBA

السهم الأزرق الحق فقاعة قم بإدراج صورة أو صورة في مربع نص برمز VBA

لإدراج صورة في مربع نص ، قد يساعدك رمز VBA التالي ، يرجى القيام بذلك على النحو التالي:

1. أدخل مربع نص عن طريق النقر إدراج > مربع النص، ثم ارسم مربع نص ، انظر الصورة:

doc إدراج الصورة في مربع النص 1

2. ثم اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

3. انقر إدراج > وحدة، والصق الكود التالي في ملف وحدة نافذة او شباك.

رمز فبا: إدراج صورة في مربع النص:

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: \ المستخدمون \ DT168 \ سطح المكتب \ الصور \ Apple.JPG هو مسار الصورة للصورة التي تريد إدراجها ، يجب عليك تغييرها حسب حاجتك.

4. ثم اضغط F5 المفتاح لتشغيل هذا الرمز ، سيتم إدراج الصورة المحددة في مربع النص مرة واحدة ، ويمكنك تحرير مربع النص كما تريد ، انظر لقطة الشاشة:

doc إدراج الصورة في مربع النص 2

مقالات ذات صلة:

كيفية تعيين قيمة افتراضية في مربع نص؟

كيف يمكن السماح بإدخال الأرقام فقط في مربع النص؟

كيفية تطبيق التدقيق الإملائي في مربع النص؟

كيفية تغيير لون مربع النص بناءً على القيمة في Excel؟

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup  |   VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير   |  مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا   |  إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات:  12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
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