حراثي تواتي

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

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

وشكرا لكم مسبقا

تواتي 11.xlsm

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

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

وشكرا مسبقا

تواتي9.xlsm

وفيت وكفيت الرائد77 حفظك الله ورعاك ودمت ذخرا لنا

ارجو من الاخوة الافاضل افادتي بكود اظهار واخفاء Button كما هو موضح بالشرح

وشكرا مسبقا

تواتي9.xlsm

وفيت وكفيت اخي سليم حاصبيا

بارك الله فيك وفي جميع الساهرين على شؤون هذا المنتدى الرائع

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

اعضاء منتدانا الغالي اريد مساعدة في التعديل على كود الطباعة كما هو موضح في الصورة

بحيث تكون قيمة الخلية D12  عدد فردي من 1 ، 2 ، 3 ، وهكذا

وشكرا لكم مسبقا

    Dim iStart As Integer, iEnd As Integer, I As Integer
    iStart = Sheet1.Range("B1").Value
    iEnd = Sheet1.Range("C1").Value
    For I = iStart To iEnd
        Sheet1.Range("D12").Value = I
        Sheet1.PrintPreview
    Next I

تواتي8.xlsm

بارك الله فيك الرائد77اخي كفيت ووفيت

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

احتاج الى كود او دالة لنقل البيانات من العمود a الى العمود b مرتبة ودون نقل البيانات الفارغة

شكرا لكم جميعا على المجهودات الجبارة التي تقمون بها بارك الله فيكم

تواتي7.xlsm

شكرا اخي

من فضلك لا تقوم برفع الملف مضغوط طالما حجمه صغير وذلك تجنباً لعدم اهدار وقت الأساتذة

تواتي5.xlsm

تمام يا رايس بالضبط هذا ما كنت ابحث عنه بارك الله فيك وفي اهلك واولادك وفي مالك واسعدك الله في الدارين

شكرا شكرا أخي

احمد بدره

بارك الله فيك أخي 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

رمضان كريم

بارك الله فيك شيخنا

انا كنت اقصد بدون صناديق الحوار

يعني كل شيء يتضمنه الكود

شكرا اخي عادل حنفي على الكود والعمل الرائع دمتم ذخرا لنا

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

يعني لا احدد له الملف V1 وانما حرية فتح اي ملف كان المهم احدد له رقم الشيت و النطاق فقط

شكرا اخي الكريم شغال 10/10

لو تكرمتم علينا مرة اخرى بكود غلق ملف الاكسيل الذي فتحته بعد نقل البيانات وسنكون لكم شاكرين

يعني بعد اتمام نقل البيانات يغلق الملف القديم

ارجوا من الاخوة الافاضل اتمام السطر المخفي و الناقص

شكرا أخي  Ali Mohamed Ali  على الاهتمام والمتابعة ، فقط اريد من ملف V2 ومن اليوزر فورم من زر استراد يقوم بفتح الملف V1 وينقل البيانات الى النطاق المحدد

اذا عملية استراد وليس ترحيل

شكرا استاذنا الفاضل

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

مرحبا بكم زوار و خبراء منتدانا الحبيب

عندي 2 ملف اكسيل الأول اسمه v1 والثاني اسمه v2 ، أريد نقل أو استراد البيانات من sheet1 من النطاق (D6:G15 ) الموجودة بالملف V1 الى الملف الثاني V2 الى نفس sheet1 ونفس النطاق بالملف الثاني

في انتظار مساعدتكم وكرمكم علينا تقبلوا مني فائق عبارات الاحترام و التقدير

نقل البيانات من ملف خارجي.rar

؟؟؟؟؟؟؟؟؟؟؟

في حاجة ماسة اليه وشكرا مسبقا

رمضان كريم

هل من مساعد ؟؟ جزاكم الله خير

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

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

https://www.officena.net/ib/topic/90950-مساعدة-في-استراد-الصورة-الى-الخلية/

حفظ الصورة.rar