اذهب الي المحتوي

حراثي تواتي

02 الأعضاء
  • Content Count

    83
  • تاريخ الانضمام

  • تاريخ اخر زياره

كل منشورات العضو حراثي تواتي

  1. تمام يا رايس بالضبط هذا ما كنت ابحث عنه بارك الله فيك وفي اهلك واولادك وفي مالك واسعدك الله في الدارين شكرا شكرا أخي احمد بدره
  2. بارك الله فيك أخي khalf على هذه الأكواد القيمة ان شاء الله ينتفع بها بقية الأعضاء أرجو من الأخوة الأفاضل تطبيق هذه الأكواد على ملفي المرفق في المشاركة لأنني مبتدء ولم استطع تطبيق ذلك في انتظار ردكم تقبلوا مني فائق عبارات الشكر والتقدير 'كود إضافة قائمة منسدلة إلى العمود الذي سيتم تغيير الصور بناء على قيمته Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Target.Column = 1 Then With Range("a" & Target.Row).Validation .Delete 'w_r=OFFSET($E$1;0;0;COUNTIF($E$1:$E$1000;"<>")) .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=w_r" .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With End If End Sub 'إدراج الصور في الخلايا Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Application.ScreenUpdating = False Dim PicM As Picture Dim pictloc As String 'Created by H-E Khalf Dim x As String If Target.Column = 1 And Range("a" & Target.Row) = "" Then x = Range("c" & Target.Row).Address & "c" ActiveSheet.Shapes(x).Delete End If If Target.Column = 1 And Range("a" & Target.Row) <> "" Then x = Range("c" & Target.Row).Address & "c" ActiveSheet.Shapes(x).Delete pictloc = Application.ActiveWorkbook.Path & "\" & Range("a" & Target.Row).Value '& ".jpg" Set PicM = ActiveSheet.Pictures.Insert(pictloc) PicM.Select PicM.ShapeRange.LockAspectRatio = msoFalse PicM.ShapeRange.Height = Range("c" & Target.Row).Height PicM.ShapeRange.Width = Range("c" & Target.Row).Height PicM.Top = Range("c" & Target.Row).Top PicM.Left = Range("c" & Target.Row).Left PicM.Placement = xlMoveAndSize PicM.Name = Range("c" & Target.Row).Address & "c" Range("a" & Target.Row).Select End If Application.ScreenUpdating = True End Sub 'تصفير البيانات Private Sub CommandButton1_Click() Call Del End Sub Sub Del() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim Sh As Excel.Shape For Each Sh In ActiveSheet.Shapes If Right(Sh.Name, 1) = "c" Then Sh.Delete End If Next Dim Cel As Range Dim C As Integer For Each Cel In Range("a1:a1000") With Cel.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With Next Range("a:a").ClearContents Range("a:a").ClearHyperlinks Selection.ClearContents Selection.ClearHyperlinks Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub ' جلب أسماء الصور من المجلد الذي سيوضع به الملف و هي من لاحقة ' jpg Private Sub Workbook_Open() Call Get_Files_Names End Sub Sub Get_Files_Names() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim fldpath Dim fso As Object, fld As Object, fil As Object, j As Long On Error Resume Next fldpath = Application.ActiveWorkbook.Path If fldpath = False Then MsgBox "Folder Not Selected" Exit Sub End If Columns("D:D").Clear Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.getfolder(fldpath) j = 1 For Each fil In fld.Files Range("D" & j).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fil.Path, _ TextToDisplay:=fil.Name ActiveSheet.Hyperlinks.Delete j = j + 1 Next Dim Cel As Range For Each Cel In Range("D1:D1000") If Right(Cel, 4) <> ".jpg" Then Cel.Delete Shift:=xlUp End If Next Dim Cel1 As Range For Each Cel1 In Range("D1:D1000") If Left(Cel1, 1) = "~" Then Cel1.Delete Shift:=xlUp End If Next Set fso = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub حفظ الصورة.rar
  3. بارك الله فيك شيخنا انا كنت اقصد بدون صناديق الحوار يعني كل شيء يتضمنه الكود
  4. شكرا اخي عادل حنفي على الكود والعمل الرائع دمتم ذخرا لنا استفسار اخر هل يمكن في نفس الكود يعطينا حرية اختيار اي ملف اكسيل نريد استراد منه البيانات من نفس النطاق وخلاص يعني لا احدد له الملف V1 وانما حرية فتح اي ملف كان المهم احدد له رقم الشيت و النطاق فقط
  5. شكرا اخي الكريم شغال 10/10 لو تكرمتم علينا مرة اخرى بكود غلق ملف الاكسيل الذي فتحته بعد نقل البيانات وسنكون لكم شاكرين يعني بعد اتمام نقل البيانات يغلق الملف القديم
  6. ارجوا من الاخوة الافاضل اتمام السطر المخفي و الناقص
  7. شكرا أخي Ali Mohamed Ali على الاهتمام والمتابعة ، فقط اريد من ملف V2 ومن اليوزر فورم من زر استراد يقوم بفتح الملف V1 وينقل البيانات الى النطاق المحدد اذا عملية استراد وليس ترحيل شكرا استاذنا الفاضل
  8. السلام عليكم ورحمة الله وبركاته مرحبا بكم زوار و خبراء منتدانا الحبيب عندي 2 ملف اكسيل الأول اسمه v1 والثاني اسمه v2 ، أريد نقل أو استراد البيانات من sheet1 من النطاق (D6:G15 ) الموجودة بالملف V1 الى الملف الثاني V2 الى نفس sheet1 ونفس النطاق بالملف الثاني في انتظار مساعدتكم وكرمكم علينا تقبلوا مني فائق عبارات الاحترام و التقدير نقل البيانات من ملف خارجي.rar
  9. بارك الله فيك اخ بن علية حاجي وجزاك عنا خير الجزاء شكرا جزيلا على اهتمامك بمساعدتنا فقط استاذي لطلب مساعدة على هذا الرابط اذ تكرمت وساعدتنا طبعا اخي في حدود الاستطاعة https://www.officena.net/ib/topic/90950-مساعدة-في-استراد-الصورة-الى-الخلية/ حفظ الصورة.rar
  10. السلام عليكم ورحمة الله وبركاته رمضان كريم على الامة الاسلامية التمس منكم مساعدة بخصوص اي طريقة يمكن بواسطها استدعاء الصورة سواء من الملف او من اليوزر فورم الى خلية محددة في الشيت حفظ الصورة.rar
  11. السلام عليكم ورمضان كريم اساتذتي اعضاء المنتدى التمس منكم مساعدة بخصوص التعديل على مساء استدعاء الصور من المجلد photos وبارك الله فيكم صح رمضانكم حفظ الصورة.rar
  12. بارك الله فيك الاخ الفاضل فقط ان لم اكثر عليك تعديل رابط اسراد الصورة من الملف المستحدث photos وشكرا مرة أخرى 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
  13. كل عام وانتم بخير استاذنا شكرا استاذنا على المتابعة و الاهتمام نعم هذا هو المطلوب بارك الله فيك استاذ ودمت ذخرا لنا تقبل مروري وخالص تحياتي استاذ
  14. كيف يمكنني تغيير مسار حفظ الصورة وذلك ب حفظ الصورة في نفس المسار ونفس المجلد الاصلي ولكن في ملف آخر اسمه photos حفظ الصورة.rar
  15. الى خبراء الاكسيل السلام عليكم ورحمة الله وبركاته كيف يمكنني ترحيل صورة من اليوزر فورم الى خلية معينة من شيت حفظ الصورة.rar
  16. شكرا أستاذنا على الاهتمام والمتابعة والرد ببساطة شيخنا أردت وضع كمبوبوكس في اليوزر فورم 1 ومنه وبقائمة منسدلة انتقل الى اليوزر فورم 2 او اليوزر فورم 3 الى غير ذلك طبعا اذا كان ممكن استاذنا وان شاء الله ما اكون كثرت عليك
  17. السلام عليكم اساتذتنا الافاضل كما هو موضح في الصورة اريد الطريقة لاستدعاء فقرات او سور قرآنية مكتوبة على الشيت الى اليوزر فورم عرض فقرة علة اليوزر فورم.rar
×
×
  • اضف...