السلام عليكم ورحمة الله وبركاته
أعرض عليكم كودا ( منقولا من أحد المنتديات الأجنبية مع التعديل لملائمة الهدف )
يمكن استخدام الكود فى نسخ صورة من اميج باليوزرفورم الى أى مكان تحدده بالهارديسك
الصورة يتم تصديرها الى الهارديسك بامتداد jpg
الكود
Option Explicit
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)
Private Sub ImageCopy()
' المتغيرات
Dim MyPic As StdPicture, MyPicName As String, xCopy
Set MyPic = Me.Image1.Picture ' حدد اسم الاميج الذى يحتوى الصورة
MyPicName = "H:\YasserKhalil.jpg" ' حدد اسم و مسار التخزين على الهارديسك
' فتح الذاكرة العشوائية
OpenClipboard 0
'تفريغ الذاكرة من البيانات
EmptyClipboard
' نسخ الصورة الى الذاكرة
xCopy = SetClipboardData(2, MyPic.Handle)
' اغلاق الذاكرة
CloseClipboard
' شرط : فى حالة وجود الصورة بالذاكرة
If xCopy Then
' جواب الشرط : حفظ الصورة المحددة بالمسار المحدد
SavePicture MyPic, MyPicName
' انهاء جملة الشرط
End If
' تفريغ الذاكرة
DestroyIcon MyPic.Handle
Set MyPic = Nothing
' رسالة بانتهاء المهمة
MsgBox "Mr.YasserKhalil Your's Picture Saved On (" & MyPicName & ")"
End Sub
استدعاء الكود ImageCopy يتم عن طريق CommandButton فى الفورم
Private Sub CommandButton1_Click()
ImageCopy
End Sub
مع خالص نحياتى
picture from UserForm to a drive.rar