اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

مساء الخير لكل الاساتذه

ارجوا مساعدتي في كود يقوم بتحميل الصورة من الجهاز إلى Image موجود في اليوزرفورم ثم يقوم بترحيل الصورة إلى الخليه v5 (صورة الطالب)

وهكذا باقي الطلاب

يعني كل طالب يتم تحميل له صورة مقابل اسمه

وهذا المرفق

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

المصنف1.rar

قام بنشر

أخي الكريم محمد علي

إذا أردت المساعدة عليك تسهيل الأمر على إخوانك

المرفق غير معبر عن الطلب .. قم بإرفاق ملف يخص طلبك فقط واحذف أية أكواد أخرى كما قم بحذف الفورم الغير مستخدم وركز على الفورم المطلوب فقط ، لتيسير الإطلاع على الملف من قبل إخوانك ..

كما أنني لم ألاحظ وجود Image على الفورم .. ما هو الفورم المطلوب العمل عليه ؟؟

أفضل إرفاق الملف مرة أخرى بعد إجراء عملية تنقيح بحيث يكون الملف يخص الطلب في الموضوع المخصص له فقط

تقبل تحياتي

 

  • Like 1
قام بنشر

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

أخي الكريم .. هذا حل بطريقة أخرى .. ليس الحل الأمثل .. لكن أفضل من البطالة ..  شغّل نفسك به قليلاً ريثما يتدخّل أحد الإخوة الأفاضل ..

تقوم بجلب رابط الصورة ثم يتم ترحيل هذا الرابط .. و من خلال الرابط على الشيت يمكنك معاينه الصّورة

 

إدراج الصورة.rar

  • Like 5
قام بنشر

أخي الكريم محمد علي

ضع الكود التالي في موديول عادي

Sub ShowForm()
    UserForm1.Show
End Sub

Function LastRowPic(ColumnNumber As Long) As Long
    Dim Arr, Pic As Shape, I As Long
    ReDim Arr(1 To Columns.Count)
    
    For Each Pic In ActiveSheet.Shapes
        With Pic
            For I = .TopLeftCell.Column To .BottomRightCell.Column
                Arr(I) = Application.Max(.BottomRightCell.Row, IIf(Arr(I) = "", 0, Arr(I)))
            Next I
        End With
    Next Pic
    
    LastRowPic = Arr(ColumnNumber)
End Function

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

#If VBA7 Then
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5

Private LastSelectedFilePath As String

Private Sub CommandButton1_Click()
    Dim strFileName As String
    
    strFileName = Application.GetOpenFilename(FileFilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select A File", MultiSelect:=False)
    
    If strFileName = "False" Then
        MsgBox "File Not Selected!"
    Else
        Me.Image1.Picture = LoadPicture(strFileName)
        LastSelectedFilePath = strFileName
        Me.Repaint
    End If
End Sub

Private Sub CommandButton2_Click()
    Dim R As Range, LR As Long
    
    ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_HIDE
    If LastRowPic(22) = 0 Then LR = Cells(Rows.Count, "V").End(xlUp).Row + 1 Else LR = LastRowPic(22)
    Set R = Range("V" & LR)
    ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
    
    With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
        .ShapeRange.LockAspectRatio = msoFalse
        .Top = R.Top
        .Left = R.Left
        .Width = R.Width
        .Height = R.Height
    End With
End Sub

وإليك الملف المرفق فيه تطبيق للأكواد

أرجو ان يكون المطلوب إن شاء الله

Load Picture On UserForm Using Dialog & Insert Image To Worksheet YasserKhalil.rar

  • Like 8
قام بنشر

1.png.034454b63926c156474b4f2ea3c740e5.p

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

تسلم أخي الغالي و أستاذي القدير ياسر خليل أبو البراء على الملف أكثر من الرّائع و الذي أظنه هو المطلوب من الأخ بالتّمام و الكمال

فقط ملاحظة صغيرة أخي الحبيب ..

عندما جربت الملف الصور على الشيت لا تظهر متسلسلة تحت بعضها إلا بالمرة الثانية .. لا أدري ما السبب ؟؟

شاهد الصورة لو تكرمت

 

 

 

  • Like 2
قام بنشر

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

أخي الحبيب عبد العزيز افتقدناك لفترة ..عسى أن يكون غيابك عن إخوانك خير إن شاء الله

 

الحمد لله أن نال الملف إعجابك ..

بالنسبة لسؤالك فيما يخص تسلسل الصور .. يتم حفظ الصور في العمود V حسب الكود الخاص بحفظ الصورة في ورقة العمل ... وهناك دالة معرفة في الموديول من خلالها يمكن معرفة أول صف فارغ ليس به صور فيقوم الكود في المرة الثانية بإدراج الصورة تحت آخر صورة تم إدراجها من قبل في العمود V فقط ..

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

  • Like 2
قام بنشر

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

بارك الله فيك أستاذي القدير ياسر خليل أبو البراء على الشّرح و التّوضيح

تمام التّمام .. بصراحة أهوى الأعمال الراقية و أنت و بدون منازع ملك الأعمال أكثر من الرّائعة و الرّاقية

باسم الله ما شاء الله

فائق إحتراماتي

  • Like 3
قام بنشر

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

الأروع مما قدمته هو كلماتك الطيبة وشعورك الطيب تجاهي

جزيت خيراً أخي الغالي عبد العزيز على كلماتك الرقيقة والتي تفوق ما أقدمه

جمعني الله وإياك في مستقر رحمته يوم القيامة

تقبل تحياتي

  • Like 3
قام بنشر

السلام عليكم ورحمة الله وبركاته بارك الله بكم إخوتي الكرام على هذا التناغم والانسجام بين أحبابي ..وهذا الملف والكود الذي لم أستخدمه بعد والذي أظنه فتحا عظيما في مجال إرفاق الصور كما هو موجود في الأكسز Access 

تقبلوا تحياتي العطرة ومحبتي 

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

 

  • Like 2
قام بنشر

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

أبي الحبيب الغالي أبو يوسف

جزيت خيراً على كلماتك الطيبة الرائعة ..

وبعدين لا فتح عظيم ولا حاجة !! كل الحكاية كود بسيط من خلاله بتحدد مكان الصورة للفورم وأعتقد إن فيه موضوعات مشابهة لهذا الأمر .. والكود الثاني بيدرج الصورة اللي في الفورم ويضعها في خلايا ورقة العمل

أنتم قرة أعيننا أبا يوسف ..جمعنا الله وإياكم في الفردوس الأعلى من الجنان

تقبل تحياتي

  • Like 3
قام بنشر

ابدعت استاذي الغالي ياسر ابو البراء هذا هو المطلوب بعينه

ربي يجزيك الجنة ووالديك امين يارب

دائماً اتعلم منك كل جديد ابدعتي استاذي الغالي

وفي الليلة الظلماء يفتقد البدر وانت البدر استاذ ياسر ابو البراء

شكرا جزيلاً لك

وايضاً الاستاذ عبد العزيز البسكري لمرورك وكلماتك الطيبة

تقديري وشكري لكم كلكم

الله يجعله في ميزان حسناتكم يارب

  • Like 1
قام بنشر

أخي الكريم محمد علي

جزيت خيراً على كلماتك الرقيقة والحمد لله أن تم المطلوب على خير ..

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

جزيت خيراً بمثل ما دعوت لي ولك بمثل إن شاء الله

تقبل تحياتي

  • Like 1
قام بنشر

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

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

  • Like 1
قام بنشر (معدل)

كود جميل بارك الله فيك وجزيت خيرا 

فيه ملاحظة : عند إستدعاء صورة يضعها في الشيت فوق بعضها البعض في الخلية واحد الأولى فقط وليس مترتبة في آخر خلية فارغة

اما هذه مشكلة في النسخة الأوفيس 2007

 

تم تعديل بواسطه ع_ حسام
خطأ
قام بنشر

أخي الحبيب أحمد الفلاحجي أبو بسملة

جزيت خيراً على تسجيعك المستمر لأعضاء المنتدى وعلى كلماتك الرقيقة ودعائك الطيب المبارك

ولك بمثل إن شاء الله

 

أخي ع_ حسام

يتم استدعاء الصورة حسب أول خلية فارغة .. سواء أكانت الخلية به قيمة بداخلها (نصية أو رقمية أو أياً كان) أو كانت الخلية بها صورة ..

إذا لم يعمل معك الكود يرجى إرفاق صورة أو ملف فيديو لتوضيح المشكلة التي تظهر لديك ..

تقبل تحياتي

قام بنشر

أخي الكريم حسام

الملف يعمل بشكل طبيعي عندي حتى بعد تحويل الورقة من اليسار إلى اليمين أو من اليمين لليسار

شاهد الفيديو التالي لتتأكد بنفسك من صحة كلامي

ويا ريت الأخوة الأعضاء يجربوا الملف عشان نتأكد من صحة عمل الملف .. قد تكون المشكلة مع بعض نسخ الأوفيس

 

Watch.rar

  • Like 1
قام بنشر

بارك الله فيك متشكر جدا

انا إستعمل 2007  ربما يكون من نسخة الأفيس.

لكي نطور الفورم ، أن يكون فورم إظافة  أجمل بحيث يكون الإسم والتاريخ الميلاد  معلومات عن شخص مثلا مع صورته وعند ترحيل ترحل المعلومات مع صورته إلى شيت 

يكون فورم ممتاز  وغير موجود من قبل بهذه الطريقة 

تقبل تحياتي الأستاذ ياسر 

 

قام بنشر

أخي الكريم

أنا لست بارعاً في تصميم الفورم بشكل كبير .. سأترك الأمر لمحترفي الفورم ليقوموا على طلبك ..

وإن شاء الله من سيقدم المساعدة في هذه الجزئية أفضل أن يقوم بطرح موضوع جديد ليستفيد أكبر عدد من الأخوة الأعضاء لأن الحلول الموجودة في طيات المشاركات لا يستفيد منها الكثير من الأعضاء وتضيع سدىً

تقبل تحياتي

  • 4 months later...
قام بنشر

أخي الكريم أبو راكان

بالنسبة لطلبك لنفترض أن الفورم يحتوي على تكست بوكس للاسم المطلوب إدراجه ، والمطلوب إدراجه في العمود G في نفس صف الخلية التي سيتم إدراج صورة بها

بما أن العمود الذي يتم إدراج صورة فيه كما في المثال العمو V والعمود المطلوب إدراج الاسم فيه هو العمود G أي يسبق العمود V بـ 17 عمود .. فيستلزم الأمر إضافة سطر واحد في نهاية الكود التالي

Private Sub CommandButton2_Click()
    Dim R As Range, LR As Long
    
    ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_HIDE
    If LastRowPic(22) = 0 Then LR = Cells(Rows.Count, "V").End(xlUp).Row + 1 Else LR = LastRowPic(22)
    Set R = Range("V" & LR)
    ShowWindow FindWindow("ThunderDFrame", Me.Caption), SW_SHOW
    
    With ActiveSheet.Pictures.Insert(LastSelectedFilePath)
        .ShapeRange.LockAspectRatio = msoFalse
        .Top = R.Top
        .Left = R.Left
        .Width = R.Width
        .Height = R.Height
    End With
    
    R.Offset(0, -19).Value = textbox1.Value
End Sub

 

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information