ابوزيد قام بنشر يوليو 11, 2015 مشاركة قام بنشر يوليو 11, 2015 (معدل) السلام عليكم ورحمة الله وبركاته رمضان مبارك - تقبل الله منكم صالح اعمالكم بجهود الاخ (خالد الرشيدي ) المبين على الرابط ادناه تم تصميم برنامج حسب متطلبات العمل التي عندي وحبيت ان اطرح سؤالي الجديد عن طريق موضوع جديد وسؤالي الجديد هو وضع صورة للموظف حسب رقم الموظف أو اسمه ، وصورة الموظف محفوظة لديه على بارتيشن D:\ فولدر (صور) اسم المستخدم زيد الرقم السري 123 http://www.officena.net/ib/index.php?showtopic=62628&hl= برنامج بطاقة الموظف الشهري والسنوي.rar تم تعديل يوليو 11, 2015 بواسطه ابوزيد رابط هذا التعليق شارك More sharing options...
زوهير قام بنشر يوليو 11, 2015 مشاركة قام بنشر يوليو 11, 2015 عليك السلام ورحمة الله وبراكاته اليك هذا الكود وجدته في احد المنتديات الاجنبية ذات وقت وكان عندي هذا الكود تضعه في الموديل وبعدها تذهب الى bar formula في تبويت fx في مكان تاوجد المعادلات تجد personalesé تجد معادلة تظهر لك بأسم AfficheImage حدد اي خلية التي تريد ان تكون صورة وجرب لعلها تعيطك النتيجة او يقوم الاساتدة الكرام بتعديل حسب طلبك Function AfficheImage(NomImage, Optional rep) Application.Volatile If IsMissing(rep) Then rep = ThisWorkbook.Path & "\" Set f = Sheets(Application.Caller.Parent.Name) Set adr = Application.Caller temp = NomImage & "_" & adr.Address Existe = False For Each s In adr.Worksheet.Shapes If s.Name = temp Then Existe = True Next s If Not Existe Then For Each k In adr.Worksheet.Shapes p = InStr(k.Name, "_") If Mid(k.Name, p + 1) = adr.Address Then k.Delete Next k If Dir(rep & NomImage) = "" Then AfficheImage = "Inconnu" Else Set myShell = CreateObject("Shell.Application") If TypeName(rep) = "Range" Then Set myFolder = myShell.Namespace(rep.Value) Else Set myFolder = myShell.Namespace(rep) End If Set myFile = myFolder.Items.Item(NomImage) Taille = myFolder.GetDetailsOf(myFile, 26) H = Val(Split(Taille, "x")(1)) L = Val(Split(Taille, "x")(0)) Ech = adr.Height / H H = H * Ech L = L * Ech f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address AfficheImage = "ok" End If End If End Function رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 11, 2015 الكاتب مشاركة قام بنشر يوليو 11, 2015 السلام عليكم الشرح صعب عليه ارجو تنفيذه على الملف المرفق سلمكم الله وزادتكم علما السلام عليكم رابط هذا التعليق شارك More sharing options...
محمد حسن المحمد قام بنشر يوليو 12, 2015 مشاركة قام بنشر يوليو 12, 2015 السلام عليكم أعرض لك ملف من إحدى مشاركات الإخوة بموضوع مشابه راجياً أن تستفيد منه http://www.officena.net/ib/index.php?app=core&module=attach§ion=attach&attach_id=45412 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 12, 2015 مشاركة قام بنشر يوليو 12, 2015 الأخ الفاضل أبو زيد يرجى وضع ملف الصور مع الملف المرفق .. للعمل عليه .. وحدد المطلوب بشكل أدق بارك الله فيك (في أي ورقة عمل تريد تطبيق المطلوب .. هل العمل سيكون بناءً على اسم الموظف أم رقمه ؟ ..) رابط هذا التعليق شارك More sharing options...
اسلام رجب قام بنشر يوليو 12, 2015 مشاركة قام بنشر يوليو 12, 2015 (معدل) فيديو بسيط بخصوص البحث عن الصور من خلال اليوزرفورم الكود سهل وبسيط جدا تم تعديل يوليو 12, 2015 بواسطه islamragab 1 رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 12, 2015 الكاتب مشاركة قام بنشر يوليو 12, 2015 (معدل) السلام عليكم الصور موجودة في البارتيشن D:|صور ونرفق ملف بالصور - (مثال) ويكون البحث على اساس رقم الموظف - واذا به مجال على الرقم والاسم واما بخصوص درج الصورة في الورقتين شيت (الشهرية و السنوية) السلام عليكم برنامج بطاقة الموظف الشهري والسنوي.rar صور.rar تم تعديل يوليو 13, 2015 بواسطه ابوزيد رابط هذا التعليق شارك More sharing options...
محمد حسن المحمد قام بنشر يوليو 13, 2015 مشاركة قام بنشر يوليو 13, 2015 فيديو بسيط بخصوص البحث عن الصور من خلال اليوزرفورم الكود سهل وبسيط جدا السلام عليكم أستاذ إسلام رجب المحترم...مرحباً بك معنا تثري منتدانا بعلمك المعهود عنك كنية رائعة واسم أروع وأجمل ما أحلى كتابتهما باللغة العربية التي لغة القرآن الكريم (( إسلام رجب)) لعلك نسيت ملف الفيديو بسبب الصوم .أم أنك حملته وانتهت مدة تحميله كما رأينا.. تقبل تحياتي والسلام عليكم. رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 13, 2015 مشاركة قام بنشر يوليو 13, 2015 تفضل أخي الكريم الملف التالي عله يفي بالغرض قم بتغيير المسار في الخلية J1 برنامج بطاقة الموظف الشهري والسنوي.rar رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 13, 2015 الكاتب مشاركة قام بنشر يوليو 13, 2015 السلام عليكم جزيت خيرا اخ ياسر - ورمضان مبارك رجاء اخر : ان تكون الصورة في خلية J1 ذات قياس واحد (حجم واحد) مهما كانت حفظ الصورة باي حجم مثلا أن تكون الارتفاع (4 سم) والعرض (4 سم) مشكورين سلمكم الله برنامج.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر يوليو 13, 2015 أفضل إجابة مشاركة قام بنشر يوليو 13, 2015 أخي الفاضل أبو زيد ... السلام عليكم إليك الكود التالي وإن شاء الله بإذن المولى يفي بالغرض تماماً .. Sub InsertPictureVBA() Dim pic As Picture, strPhotosFolder As String, strPhoto As String strPhotosFolder = ThisWorkbook.Path & "\صور\" Application.ScreenUpdating = False With Sheets("بطاقة الموظف السنوية") While .Pictures.Count .Pictures(1).Delete Wend strPhoto = strPhotosFolder & Trim(.Range("B2").Value) & ".*" strPhoto = Dir(strPhoto) If Len(strPhoto) Then strPhoto = strPhotosFolder & strPhoto .Pictures.Insert (strPhoto) Set pic = .Pictures(.Pictures.Count) With pic .ShapeRange.LockAspectRatio = msoFalse .Left = .Parent.Range("J1").Left .Top = .Parent.Range("J1").Top .Width = .Parent.Range("J1").Width .Height = .Parent.Range("J1").Height End With End If End With Application.ScreenUpdating = True End Sub كل ما عليك فعله هو تغيير مسار مجلد الصور من هذا السطر strPhotosFolder = ThisWorkbook.Path & "\صور\" ليصبح بهذا الشكل strPhotosFolder = "D:\صور\" كما تمت إضافة سطر في حدث الورقة المسماة "بطاقة الموظف السنوية" ليتم تنفيذ الكود بمجرد التغير في الخلية B2 ... قم بكتابة رقم الموظف لتظهر الصورة الخاصة به في الخلية J1 بنفس الأبعاد للخلية .. الملفات في مجلد الصور تكون بأرقام الموظفين .. كل موظف له صورة مسماة برقمه أو يمكنك التعديل في الكود بما يحلو لك ... ليناسب طلبك أياً كان تقبل الله منا ومنكم صالح الأعمال ولا تنسى أن تحدد أفضل إجابة كما لا تنسى أن تضغط أعجبني هذا إذا أعجبك بالطبع برنامج البطاقة الشهرية والسنوية.rar 2 رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 13, 2015 الكاتب مشاركة قام بنشر يوليو 13, 2015 السلام عليكم احسنت - جزيت خيرا - تقبل الله منكم الحل ممتاز رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 13, 2015 الكاتب مشاركة قام بنشر يوليو 13, 2015 السلام عليكم تم اكمال شيت بطاقة الموظف السنوية محتاجين اكمال شيت البطاقة الشهرية (درج صورة الموظف في شيت بطاقة الموظف) بنفس مواصفات ومعادلات شيت بطاقة الموظف السنوية وفقكم الله - شكرا على جهودكم رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 13, 2015 مشاركة قام بنشر يوليو 13, 2015 أخي الكريم حاول أن تنسخ الكود الموجود في محرر الأكواد .. وعدل فيه بما يناسب طلبك الموضوع بسيط إن شاء الله .. حاول أن تتعلم وكفاك أسماكاً جاهزة (جرب تصطاد السمكة بنفسك وشوف طعم السمك هتلاقيه مختلف تماماً ..) 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 13, 2015 مشاركة قام بنشر يوليو 13, 2015 السطر التالي يحدد مسار مجلد الصور strPhotosFolder = ThisWorkbook.Path & "\صور\" ************************************* السطر التالي With Sheets("بطاقة الموظف السنوية") يحدد ورقة العمل المطلوب العمل عليها *************************************** السطر التالي strPhoto = strPhotosFolder & Trim(.Range("B2").Value) & ".*" غير اسم الخلية B2 باسم الخلية اللي فيها رقم الموظف (التي يتم كتابة رقم الموظف بها) ************************************* الأسطر التالية .Left = .Parent.Range("J1").Left .Top = .Parent.Range("J1").Top .Width = .Parent.Range("J1").Width .Height = .Parent.Range("J1").Height هتغير اسم الخلية التي يوضع بها الصور J1 إلى الخلية التي تريد إدراج الصورة بها بس خلاص الموضوع بسيط مش معقد أخي الفاضل أبو زيد رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 14, 2015 الكاتب مشاركة قام بنشر يوليو 14, 2015 السلام عليكم استاذ ياسر خليل المحترم جزاك الله خير نسخت الكود وغيرت الخلية كما وجهت ، ولكن اكو شغلة ؟؟؟ بحيث لا تظهر الصورة في الخانة وادناه الملف الذي غيرت به حسب الخطوات التي قلت بها في المشاركة اعلاه للتفضل بالاطلاع السلام عليكم برنامج1.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 14, 2015 مشاركة قام بنشر يوليو 14, 2015 غير اسم الماكرو الجديد دي أول ملحوظة لاحظتها بعد تنزيل ملفك مينفعش يكون فيه 2 ماكرو بنفس الاسم .. اجعل اسم الماكرو الجديد باسم InsertPictureVBA2 مثلاً روح اعمل كليك يمين على اسم ورقة العمل "بطاقة الموظف" ثم View Code ثم عدل الكود الموجود ليكون بهذا الشكل ليتم تنفيذ الكود بمجرد التغير في الخلية B3 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3")) Is Nothing Then Z = Application.CountA(Sheets("الشهر الاول").Range("A2:A300")) For I = 2 To Z + 2 If Target.Value = Sheets("الشهر الاول").Cells(I, 1).Value Then Target.Offset(0, 2).Value = Sheets("الشهر الاول").Cells(I, 2).Value End If Next I Call InsertPictureVBA2 End If End Sub جرب أعملني بالنتيجة رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 14, 2015 الكاتب مشاركة قام بنشر يوليو 14, 2015 السلام عليكم لم احصل على نتيجة فعندما اغير في خلية B3 يذهب الايعاز الى محرر الكواد Private Sub Worksheet_Change(ByVal Target As Range) يصبح باللون الاصفر If Not Intersect(Target, Range("B3")) Is Nothing Then Z = Application.CountA(Sheets("الشهر الاول").Range("A2:A300")) For I = 2 To Z + 2 If Target.Value = Sheets("الشهر الاول").Cells(I, 1).Value Then Target.Offset(0, 2).Value = Sheets("الشهر الاول").Cells(I, 2).Value End If Next I Call InsertPictureVBA2 - يقف المؤشر على هذا السطر End If End Sub ممكن عمل فيديو ليكون اكثر ايضاحاً لي السلام عليكم رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر يوليو 14, 2015 مشاركة قام بنشر يوليو 14, 2015 السلام عليكم ورحمة الله وبركاته رمضان كريم على الجميع الاستاذ الفاضل ابوالبراء جزاكم الله خيرا اعمالكم في قمة الابداع اخي العزيز ابوزيد غيرت في موضع الصورة بدل J1 جعلتها D1 وازلت دمج الخلية التي فيها الصورة والحمد لله الكود اكثر من رائع من استاذ مبدع دون مجامله وفقكم الله وزادكم خيرا برنامج 1.rar 2 رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 14, 2015 الكاتب مشاركة قام بنشر يوليو 14, 2015 السلام عليكم جزيت خير رمضان مبارك رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 14, 2015 مشاركة قام بنشر يوليو 14, 2015 أخي الكريم أبو زيد هل تم عمل المطلوب بشكل جيد الآن أم لا؟ رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 14, 2015 الكاتب مشاركة قام بنشر يوليو 14, 2015 (معدل) السلام عليكم استاذ ياسر ما اشتغل - يمكن الخلل من يمي ما اعرف - بس طبقت كل التوجيهات ؟؟؟ الله يرضى عليك طبق الكود على الملف - وبالتالي اكدر قارن بين توجيهاتك وعملي السلام عليكم تم تعديل يوليو 14, 2015 بواسطه ابوزيد رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 14, 2015 مشاركة قام بنشر يوليو 14, 2015 ما هي نسخة الأوفيس التي تعمل عليها؟ رابط هذا التعليق شارك More sharing options...
ابوزيد قام بنشر يوليو 14, 2015 الكاتب مشاركة قام بنشر يوليو 14, 2015 السلام عليكم 2010 جزيت خيرا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 14, 2015 مشاركة قام بنشر يوليو 14, 2015 أنا أعمل على أوفيس 2013 ويعمل بشكل جيد عندي جرب الملف المرفق الذي قدمه لك الأخ الحبيب الغالي الغائب عن العيون محمد أبو عباس في المشاركة رقم 19 http://www.officena.net/ib/index.php?showtopic=62661#entry406484 جربت الملف ويعمل في ورقتي العمل بشكل ممتاز جرب تنصب أوفيس 2013 (خليك مع الجديد .. عشان تستفيد) رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان