Alaaq3 قام بنشر نوفمبر 5, 2021 مشاركة قام بنشر نوفمبر 5, 2021 السلام عليكم ورحمة الله : الاساتذة الكرام ارجو المساعدة في موضوع حفظ مكان الصور . هذا الفورم المرفق يقوم بحفظ الصور بجانب ملف الاكسل . وانا اريد ان يحفظها في مكان اخر مثلا ( ملف الاكسل على سطح المكتب والصور في قرص /:E) بيان الموظفين.xlsm Private Sub CommandButton1_Click() Unload Me End Sub Private Sub CommandButton2_Click() image_path = Application.GetOpenFilename(FileFilter:="Picture Files (Fichiers image),*.gif;*.jpg;*.jpeg;*.bmp", Title:="اختار الصورة") If image_path <> False Then Me.Image1.Picture = LoadPicture(image_path) Me.Image1.Visible = True End If End Sub Private Sub CommandButton3_Click() If TextBox2.Value = "" Then MsgBox "ادخل اسم الصورة اولا": Exit Sub Var = TextBox2.Text مكان حفظ الصور ' SavePicture Image1.Picture, ThisWorkbook.Path & "\" & Var & ".jpg" MsgBox "تم حفظ الصورة بنجاح مع تحيات مجدى يونس", vbInformation End Sub Private Sub Image1_Click() End Sub Private Sub TextBox1_Change() '============================= Dim MYPATH MYPATH = ThisWorkbook.Path & "\" & TextBox1.Text & ".JPG" If Right(MYPATH, 1) <> "\" Then On Error GoTo 1 Image1.Picture = LoadPicture(MYPATH) Else 1: 'MsgBox "هذا الصورة غير موجودة", vbInformation, "خطأ" 'Image1.Picture = LoadPicture() Image1.Picture = LoadPicture(ThisWorkbook.Path & "\M.JPG") Exit Sub End If '========================================== End Sub Private Sub TextBox2_Change() End Sub Private Sub UserForm_Click() End Sub Private Sub Yh_ListFind_Click() On Error Resume Next Dim MYSH As Worksheet Dim S_1 As String S_1 = Yh_ListFind.List(Yh_ListFind.ListIndex, 6) Set MYSH = Sheets("new") With MYSH .Select .Range(S_1).Select End With TextBox1.Value = Range(S_1).Value End Sub Private Sub Yh_ListFind_DblClick(ByVal cancel As MSForms.ReturnBoolean) On Error Resume Next Dim MYSH As Worksheet Dim S_1 As String S_1 = Yh_ListFind.List(Yh_ListFind.ListIndex, 6) Set MYSH = Sheets("new") With MYSH .Select .Range(S_1).Select End With Me.Hide End Sub Private Sub Yh_TextFind_Change() On Error Resume Next Dim MYSH As Worksheet Dim V As Integer, LastRow As Integer Dim M As String Dim A, F Yh_ListFind.Clear If Yh_TextFind.Text = "" Then GoTo 1 M = Yh_TextFind.Text Set MYSH = Sheets("new") With MYSH LastRow = .Cells(.Rows.Count, "d").End(xlUp).Row Set A = .Range("d13:d" & LastRow).Find(M) If Not A Is Nothing Then F = A.Address Do If Application.WorksheetFunction.Search(M, A, 1) = 1 Then Yh_ListFind.AddItem A.Value Yh_ListFind.List(V, 1) = A.Offset(0, 1).Value Yh_ListFind.List(V, 2) = A.Offset(0, 2).Value Yh_ListFind.List(V, 3) = A.Offset(0, 3).Value Yh_ListFind.List(V, 4) = A.Offset(0, 4).Value Yh_ListFind.List(V, 5) = A.Offset(0, 5).Value Yh_ListFind.List(V, 6) = A.Address V = V + 1 End If Set A = .Range("d13:d" & LastRow).FindNext(A) Loop While Not A Is Nothing And A.Address <> F End If End With On Error GoTo 0 1 End Sub رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالفتاح في بي اكسيل قام بنشر نوفمبر 5, 2021 أفضل إجابة مشاركة قام بنشر نوفمبر 5, 2021 الرجاء ضع الكود في <> كما موجود في اعدادات الكتابة والتنسيق لديك غير مجرب . مجرد محاولة كما ترى انشا مجلد في اي محرك تريده ثم قم بنسخ امتداده وضعه في الكود Private Sub CommandButton3_Click() Const csPath As String = "C:\Test\" If TextBox2.Value = "" Then MsgBox "ادخل اسم الصورة اولا": Exit Sub Var = TextBox2.Text مكان حفظ الصور ' SavePicture Image1.Picture, csPath & Var & ".jpg" MsgBox "تم حفظ الصورة بنجاح مع تحيات مجدى يونس", vbInformation End Sub 1 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر نوفمبر 5, 2021 مشاركة قام بنشر نوفمبر 5, 2021 وعليكم السلام ورحمة الله وبركاته استبدل هذه الجمله ThisWorkbook.Path & "\" الى "E:\" 1 رابط هذا التعليق شارك More sharing options...
Alaaq3 قام بنشر نوفمبر 7, 2021 الكاتب مشاركة قام بنشر نوفمبر 7, 2021 احسنتم كثيرا كيلا الطريقتان نجحتا 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان