ادراج صورة مع الشهادة

[2saad]

إخواني الأعزاء خبراء المنتدي بعد سلام الله عليكم ورحمة الله وبركاته

مرفق لكم شيت للنابغة ساجدة العزاوي من العراق بارك الله فيها وفيكم جميعا

وهو شيت لطباعة شهادتين في ورقة واحدة

والمطلوب كيف اضع صورة للطالب ورمرفق مع الشيت ملف به مجموعة من الصور كنموذج

 

saad.rar

[محمد ثابت]

هل تريد وضها هكذا ؟

 

 

[محمد ثابت]

خطوات إدراج صورة . 

بالصور

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

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

اخى الكريم اين المكان الذى تريد وضع الصورة فيه

حيث ان الشهادة مليئة بالبيانات 

و لا تتيح مكان للصورة

[2saad]

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

شكرا جزيلا يا أستاذ ابراهيم علي رد حضرتك

بالنسبة لوضع الصورة نضعها في الخلية ( n2 ) بعد تصغيرها 

 

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

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

استخدم الكود التالى

ملحوظة هامة : الكود يعمل على ارقام الجلوس و ليس الاسماء لان اسماء الصور بارقام الجلوس

Sub InsetPics()
Dim ws As Worksheet
Dim Pth As String, SName As String
Dim Pic As Object, C As Range, Rng As Range
Set ws = Sheets("شهاده محدده ترم2")
Application.ScreenUpdating = False
For Each Pic In ws.Pictures
Pic.Delete
Next
Pth = ActiveWorkbook.Path
On Error Resume Next
For i = 3 To 19 Step 16
Set C = ws.Range("M" & i)
Set Rng = ws.Range("N" & i - 1)
SName = Pth & "\photo\" & C & ".jpg"
Set Pic = ActiveSheet.Pictures.Insert(SName)
If Not IsEmpty(Pic) Then
With Pic
.Top = Rng.Top
.Left = Rng.Left
.Width = Rng.Width
.Height = Rng.RowHeight
.Name = C.Value
End With
End If
Next
Application.ScreenUpdating = True
End Sub

 

[2saad]

استاذ ابراهيم شكرا لرد حضرتك

حضرتك جربت الكود انا وضعت الكود في موديول جديد ولم تظهر الصور في الشهادات

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

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

لم يعمل معك الكود بسبب لبخلايا المدمجة  ... اليك الملف

saad.rar

[2saad]

انا أسف يا أستاذ إبراهيم

أتمني أن يتسع صدرك .. انا عايز لما أطبع الشهادات تتغير الشهادة مع الصورة علي حسب رقم الجلوس زي ما حضرتك ذكرت أو بالاسم ,,شكرا لحضرتك

 

 

 

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

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

فى كل كود من الاكواد الاربعة السابقة لهذا الكود

استبدل تلك السطور

If Sheets(2).Cells(19, 13) = "" And Sheets(2).Cells(3, 13) <> "" Then
Sheets(2).Range("a1:p15").PrintOut
End If

بهذه السطور 

If Sheets(2).Cells(19, 13) = "" And Sheets(2).Cells(3, 13) <> "" Then
    Call InsetPics
    Sheets(2).Range("a1:p15").PrintOut
    End If