مشكلة دمج الخلايا في دالة VLOOK_Pic1

[سمير نجار]

السلام عليكم ورحمة الله وبركاته

السادة الكرام مشرفين وأعضاء

من جديد مع دالة عمر الحسيني ابوتامر

الصورة لاتظهر بأبعادها الحقيقية اذا كانت أكبر من الخلية الموضوعة فيها

في المرفقات دالة ابوتامر و شرح للدالة

وايضاً في المرفقات ملفي المطلوب مع الشرح

ولكم كل الشكر

 

ادراج صورة في الخلية حسب الاسم او الرقم.rar

شرح VLOOK_Pic1.rar

الاسم مع الصور.rar

[ابراهيم الحداد]

شكرا جزيلا لك وبارك الله فيك

[سمير نجار]

تسعدني مشاركتك اخي الكريم zizo58 وبارك الله فيك

 

بانتظار الحل إخوتي الكرام

 

:rol: :rol:

[عبدالله باقشير]

السلام عليكم

 

قد تنفعك هذه الدالة فيها امكانية تحديد الطول والعرض

 

http://www.officena.net/ib/index.php?showtopic=47835

 

تحياتي

[سمير نجار]

السلام عليكم ورحمة الله وبركاته

استاذي الكريم عبدالله باقشير بارك الله فيك ونفعنا الله بعلمك وفي ميزان حسناتك إن شاء الله تعالى

نعم سيدي تنفع هذه الدالة وزيادة

كنت قد وجدت هذه الدالة بعد طرحي لهذا الموضوع

و لي طلب صغير من حضرتك .

تظهر حدود ملونة للصورة التي تجلبها الدالة فهل بالإمكان أن تظهر الصورة بدون حدود كما هي عليه.

وأيضاً لي سؤال : سواء بالنسبة لدالتك أو لدالة  ابوتامر هل يوجد حل لمشكلة دمج الخلايا

 

وكل الشكر والتقدير لك سيدي

[سمير نجار]

:rol: :rol: :rol: :rol:

[سمير نجار]

و لي طلب صغير من حضرتك .

تظهر حدود ملونة للصورة التي تجلبها الدالة فهل بالإمكان أن تظهر الصورة بدون حدود كما هي عليه.

وأيضاً لي سؤال : سواء بالنسبة لدالتك أو لدالة  ابوتامر هل يوجد حل لمشكلة دمج الخلايا

 

وكل الشكر والتقدير لك سيدي

[عبدالله باقشير]

و لي طلب صغير من حضرتك .

تظهر حدود ملونة للصورة التي تجلبها الدالة فهل بالإمكان أن تظهر الصورة بدون حدود كما هي عليه.

اضفت السطر هذا الى الدالة

.Line.Visible = msoFalse

ضعه في المكان الذي تراه موجود فيه ادناه

في كود الدالة في ملفك

Option Explicit
Option Compare Text
'=============================================
'          عرض صورة في الخليةِ
'       Showing an image in cell
'=============================================
'           اسم مجلد الصور
' اذا كان مجلد الصور في نفس مجلد ملف الاكسل
'           اكتب اسمه فقط
'        والا اكتب المسار كاملا
' "D:\MyDocument\MyFunction\photo"

Private Const kh_pic As String = "MyImeg"
'=============================================
'  امكانية تحرير اي نوع من الصور لديك ادناه
Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif"
'=============================================
'=============================================

Function kh_ShowImage(ByVal NameImag, ByVal ImagRng As Range, Optional ByVal MyWidth As Single, Optional ByVal MyHeight As Single)
Dim Tp
Dim shp As Shape
Dim ibo As Boolean
Dim MyTop As Single, MyLeft As Single
Dim MyFile As String, MyPath As String
'----------------------------------
On Error GoTo 1
'----------------------------------
MyTop = ImagRng.Top: MyLeft = ImagRng.Left
With ImagRng.Worksheet
    For Each shp In .Shapes
        If shp.Top = MyTop And shp.Left = MyLeft Then
            shp.Delete: Exit For
        End If
    Next shp
End With
'-----------------------------------
If IsEmpty(NameImag) Then GoTo 1
'-----------------------------------
If MyWidth = 0 Then MyWidth = ImagRng.Width
If MyHeight = 0 Then MyHeight = ImagRng.Height
'-----------------------------------
If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.path & "\"
MyFile = MyPath & kh_pic & "\" & CStr(NameImag)
'-----------------------------------
For Each Tp In Split(MyTyp, ",")
    If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then
        With ImagRng.Worksheet.Shapes.AddShape(msoShapeRectangle, MyLeft, MyTop, MyWidth, MyHeight)
            .Fill.UserPicture MyFile & Trim(Tp)
            .Line.Visible = msoFalse
        End With
        ibo = True
        Exit For
    End If
Next
1
kh_ShowImage = ibo
End Function

اما الدمج فلا انصح به

 

تحياتي

[سمير نجار]

أستاذي الكريم عبدالله باقشير

بارك الله فيك ونفعنا بعلمك وزادك وإيانا من واسع علمه

     

 

كل الشكر والتقدير لك سيدي