درج الصورة في بطاقة الموظف

[ابو نبأ]

السلام عليكم

 

الله يرضى عليكم عندي سؤال

وسؤالي موضح بالملف المرفق كمثال ، راجين النظر والاجابة عليه

 

جزاكم الله خيرا

 

السلام عليكم

بطاقة الموظف.rar

[ابو نبأ]

السلام عليكم

 

الله يرضى عليكم عندي سؤال

وسؤالي موضح بالملف المرفق كمثال ، راجين النظر والاجابة عليه

 

جزاكم الله خيرا

 

السلام عليكم

بطاقة الموظف.rar

[ابو القبطان]

الحل اخي يعتمد على الاسم 

دعواتك لمن أبدعه ، وليس لي ، إنه من مقتنياتي

File N Foler.rar

[ابو نبأ]

سلمك الله

 

ممكن درج المعادلة في الخلية المخصصة للصورة 

لان المعاداة المرسلة لم تعمل ارجو تكون الاجابة على الملف المرفق

شكرا

[ابو تراب]

هلا ابو نبأ

 

جرب المرفق

 

ملاحظة

=====

عدلت لك الكود بحيث يمكنك من استخدامها في شيت البيانات و شيت البطاقة

 

كيفية استدعاد الدالة

=InsertPic("البطاقة","D:\صور\"&$B$1&".jpg",$B$1,1,3)

CurSheet: يمثل اسم الشيت الحالية...مثال: البطاقة

 

PicPath : يمثل مسار الصورة مثلا : "D:\صور\"&$B$1&".jpg" حيث الخلية B1 هيى رقم الموظف

 

PicName : اسم الصورة مثال B1 حيث ثمثل رقم الموظف

 

Row : رقم سطر الخلية المراد وضع الصورة فيها... هنا نضع 1 لان الخلية في المثال المرفق هى C1

Col : يمثل رقم عمود خلية الصورة... C1 و هنا سنضع الرقم 3 لان الحرف C يمثل الرقم ثلاثة

Public Function InsertPic(CurSheet As String, PicPath As String, PicName As String, Row As Long, Col As Long)
Dim pic As Shape
Dim PicWidth As Double
Dim PicHeight As Double


Dim WBSheet As Worksheet


Set WBSheet = Sheets(CurSheet)


For Each pic In WBSheet.Shapes
    If pic.Name = PicName Then pic.Delete
Next


With WBSheet.Pictures.Insert(PicPath)
    With .ShapeRange
        .LockAspectRatio = msoFalse
        .Width = WBSheet.Cells(Row, Col).Width
        .Height = WBSheet.Cells(Row, Col).Height
        .Name = PicName
    End With
    .Left = WBSheet.Cells(Row, Col).Left
    .Top = WBSheet.Cells(Row, Col).Top
    .Placement = 1
    .PrintObject = True
End With


Set WBSheet = Nothing


End Function

بطاقة الموظف.zip

[ابو القبطان]

تم التعديل كما اردت ، وعليك تغيير المدى حسب احتياجك

File N Foler2.rar

[samcom comsam]

http://www.officena.net/ib/profile/46211-ابو-القبطان/

مجهود اكثر من  رائع