(موضوع مميز) دالة لاضافة صور من مجلد الى شكل تلقائي

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

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

جمعة مباركة

دالة لاضافة صور الى نموذج معين من فولدر

المطلوب فيها اسم الصورة واسم الشكل التلقائي الذي تريد اظهار الصورة فيه

ملاحظة مهمة :

عند تعيين الخلية اللي فيها اسم الصورة يجب ان يكون ملحوق باسم الورقة

مثلا

=kh_AddPicture(Sheet1!H2;"myimg1")

كود الدالة :

Option Explicit

Option Compare Text

'''اسم مجلد الصور

Private Const kh_pic As String = "MyImeg"



Function kh_AddPicture(MyRng As Range, iName As String)

Dim MyFile As String

On Error GoTo 1

MyRng.Worksheet.Shapes(iName).Fill.Solid

MyFile = ThisWorkbook.Path & "\" & kh_pic & "\"

MyFile = MyFile & "\" & CStr(MyRng) & ".jpg"

If Not Dir(MyFile, vbDirectory) = vbNullString Then

	MyRng.Worksheet.Shapes(iName).Fill.UserPicture MyFile

End If

1

kh_AddPicture = ""

End Function

هو طلب لاحدهم وجعلته هنا لتعم الفائدة المرفق اكسل 2003 اكسل 2007 دالة لاضافة صور الى نموذج معين من فولدر.rar

===================================================

ملحوظة

ارجوا من الذين حملوا المرفق هذا يغيروا كود الدالة الى الكود المعدل

ادناه

===================================================

تم تعديل الدالة لتشمل صيغ الصور التي تريدها

كود الدالة الجديد

Option Explicit

Option Compare Text

'=============================================

'=============================================

'		   اسم مجلد الصور

' اذا كان مجلد الصور في نفس مجلد ملف الاكسل

'		   اكتب اسمه فقط

'		والا اكتب المسار كاملا

' "D:\MyDocument\MyFunction\photo"


Private Const kh_pic As String = "MyImeg"

'=============================================

'  امكانية تحرير اي نوع من الصور لديك ادناه

Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif"

'=============================================

'=============================================



Function kh_AddPicture(MyRng As Range, iName As String)

Dim Tp

Dim MyShap As Shape

Dim MyFile As String, MyPath As String

Dim ibo As Boolean

'-----------------------------------------

On Error Resume Next

Set MyShap = MyRng.Worksheet.Shapes(iName)

If iName = "" Or Err Then Err.Clear: GoTo 1

'-----------------------------------------

MyShap.Fill.Solid

If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.Path

MyFile = MyPath & "\" & kh_pic & "\" & CStr(MyRng)

'-----------------------------------------

For Each Tp In Split(MyTyp, ",")

	If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then

		MyShap.Fill.UserPicture MyFile & Trim(Tp)

		ibo = True

		Exit For

	End If

Next

'-----------------------------------------

1:

Set MyShap = Nothing

kh_AddPicture = ibo

End Function

المرفق اكسل 2003/2007

دالة لاضافة صور من مجلد الى شكل تلقائي.rar

[عبدالله المجرب]

ما شاء الله عليك استاذ عبدالله

دالة قمة في الروعة ومهمة جداً وعملية

بارك الله فيك

===

استاذنك في تثبيت الموضوع

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

ما شاء الله عليك استاذ عبدالله

دالة قمة في الروعة ومهمة جداً وعملية

بارك الله فيك

===

استاذنك في تثبيت الموضوع

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

اخي عبدالله و بارك الله فيك

وشكرا جزيلا على التشجيع والتثبيت

وجمعة مباركة

ودمتم في حفظ الله

[عبدالله المجرب]

العفو منك

ومهما قلت من كلمات المدح فلن اوفيك حقك

[abouelhassan]

شكر من القلب

تقدير من القلب

احترام من القلب

[دغيدى]

الأستاذ / الفاضل / خبور

سلام الله عليكم وعلى أهلى باليمن

جمعة مباركة

عمل طالما انتظرته كثيرا فتح الله عليكم من علمه واثابكم عليه

[القومي]

استاذنا الفاضل / خبور

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

لااستطيع ان اقدم الا الشكر والتقدير

[قصي]

عمل طالما انتظرته كثيرا فتح الله عليكم العلامة عبد الله

واثابكم عليه

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

[وليد المصرى 1]

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

اشكركم

[وليد المصرى 1]

اشكرك اخى ابو احمد واشكر الاستاذ الكبير استاذى خبور انا لا اعلم ان الاستاذ خبور اسمة (عبدلله باقشير )لان اسمع عنة بأسم خبور ولكن هذة المرة عرفت اسمة استاذ عبدلله لانة افدنى كثيرا قبل هذا الوقت بمعادلات واكواد فى هذا المنتدى العظيم وكان لى شرف كبير ان يهتم بملفى جزاك الله الف خير يا استاذ خبور وايضا اشكر استاذ محمد يحياوى لانة اضاف ايضا على ملف لمسة جمالية بكود غاية فى الروعة

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

اشكر كل من ساهم فى هذا الملف

الى الامام والتفوق خبراء هذا المنتدى العظيم

اشكركم جميعا

[قصي]

هذا الموضوع مهم جدا في كثير من الاعمال على سبيل المثال

اخراج كروت للطلاب بالأسماء والصف الدراسي والعنوان ورقم خاص بالطالب

مع صورة الطالب

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

[mhrrd]

هذا الموضوع مهم جدا في كثير من الاعمال على سبيل المثال

اخراج كروت للطلاب بالأسماء والصف الدراسي والعنوان ورقم خاص بالطالب

مع صورة الطالب

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

بعد اذن حضراتكم كيف اغير موقع الصوره في الكارت

[الشهابي]

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

إبداع وتميز لا حدود له

فعلا دالة مهمة جداً وعملية وخاصة بالنسبة لنا كمعلمين

بارك الله وجزاك الله خير وزادك علماً ورفعة

[أ / محمد صالح]

هذا الموضوع مهم جدا في كثير من الاعمال على سبيل المثال

اخراج كروت للطلاب بالأسماء والصف الدراسي والعنوان ورقم خاص بالطالب

مع صورة الطالب

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

بارك الله لك أخي عبد الله

مثال رائع حقاً

أخي الكريم قصي

المثال يصلح لما تريد فقط يلزمك وضع صور للطلاب في مجلد الصور

واجعل اسم صورة كل طالب هي رقم مسلسله مثلا

ثم اكتب في الخلية الخاصة باسم الصورة رقم الطالب

سيتم عرض صورته

[محمد يحياوي]

الاستاذ الكبير عبد الله رقم اخر و دالة رائعة اخرى تضاف الى هذا الصرح العظيم بعد دالة الاستاذ ابوثامر فجزاك الله عنا خير الجزاء

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

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

الشكر واصل لجميع المشاركين

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

عرفت من الردود اعلاه ان الدالة هذه مهمة

ان شاء الله ساقوم بتطويرها لتشمل صيغ الصور الاخرى

ودمتم في حفظ الله

[naderwatfa]

رائع جداً أخي عبد الله ... الله ينور لك طريقك يارب

[mhrrd]

بعد اذن حضراتكم كيف اغير موقع الصوره في الكارت

[احمد فضيله]

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

[احمد فضيله]

عمل اكثر من رائع

تسلم الايادي

[saffaa]

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

[جمال الفار]

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

اخى فى الله عبدالله (خبور )

لا نستطيع ان نتكلم لان اعمالك تتحدث عنك

مبدع لا تاتى الا بالثمين المفيد

هذه هى عادتك دا ئما تفيد

وفقكم الله وجعله فى ميزان حسناتكم

اخيك جمال الفار

[asdhamdey]

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

الشكر واصل لجميع المشاركين

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

عرفت من الردود اعلاه ان الدالة هذه مهمة

ان شاء الله ساقوم بتطويرها لتشمل صيغ الصور الاخرى

ودمتم في حفظ الله

lمبدع استاذ عبد الله على

رينا يسعدك

لو اضافه عندما لايوجد صورة للطالب نرجو عدم ظهور الفرام

[asdhamdey]

استاذي الفاضل عبد الله باقشير

اعداد الطلاب كثيره ونريد هذا الكود يعمل اوتوماتيك بدل ان اضع رقم الصوره

وقد طلبت عندما لايوجد صوره للطالب نرجو عدم ظهور الفرام المسامحه في هذا الطلب لان الفرام مهم

والطباعه مهم

الله يرضى عليك وعلينا

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

بعد اذن حضراتكم كيف اغير موقع الصوره في الكارت

الصورة تظهر في الشكل التلقائي اللي سميته في الدالة

انقل الشكل التلقائي الى اي مكان تريده

يعني لا يهم موقع خلية الدالة ممكن تكون في اي مكان في الورقة

شاهد المرفق الجديد في المشاركة الاولى