أكاديمية الصقر للتدريب
FBConnect

اعلان هنا
صقور الاكسيل
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا




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

Preview

الرئيسية
نتائج البحث


نتائج البحث عن ردود العضو :salim
عدد النتائج (775) نتيجة
27-03-2021 09:51 صباحا
icon كود ترحيل من الليست بوكس الي الشيت | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 لا أعلم اذا كان هذا ما تريده

Private Sub Cmd_Clera_Click()
Me.ListBox1.Clear
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton1_Click()
 For I = 1 To 9
 Me.Controls("TextBox" & I) = _
  Chr(Application.RandBetween(65, 90)) & " " & _
  Chr(Application.RandBetween(65, 90))
 Next
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++

Private Sub ADD_To_shett_Click()
If Me.ListBox1.ListCount = 0 Then Exit Sub
Dim z%
 With Sheets("sheet1")
 z = .Cells(Rows.Count, 1).End(3).Row + 1
   .Cells(z, 1).Resize(ListBox1.ListCount, 9).Value = _
    ListBox1.List
 End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub ADD_To_list_Click()
Dim n As Byte, t, k%
For t = 1 To 9
 If Me.Controls("TextBox" & t) <> vbNullString Then
 k = k + 1
End If
Next
 If k Then
With Me.ListBox1
   .AddItem
     For n = 0 To .ColumnCount - 1
    .List(.ListCount - 1, n) = _
     Me.Controls("TextBox" & n + 1)
    Next
   End With
 End If
End Sub


الملف مرفق
26-03-2021 11:08 صباحا
icon مسح بيانات من نطاق مرن متغير | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الماكرو (يقوم باخفاء الصفوف وليس حذفها)
        (اذا كنت تريد الحذف يمكن التعديل)

Sub My_Macro()

Dim LASTROW
Dim Rg As Range
Dim Impt
Dim Sh As Worksheet
Set Sh = Sheets("ElectronicPayment")
Show_ALL

LASTROW = Sh.Cells(Rows.Count, 1).End(3).Row

Impt = Application.InputBox("Put an Number <= " & LASTROW _
       , 1, Type:=1)
  If Val(Impt) <= 0 Or CInt(Impt) > LASTROW Then
   MsgBox "You must type Only number<=  " & LASTROW
   Exit Sub
  
  End If
  Impt = Int(Impt)
 Set Rg = Sh.Range("A" & Impt).Resize(LASTROW - Impt + 1, 7)
 Rg.EntireRow.Hidden = True
 
End Sub
'+++++++++++++++++++++++++++++++++++++++
Sub Show_ALL()
Sheets("ElectronicPayment").Rows.Hidden = False
End Sub

الملف مرفق
24-03-2021 08:57 مساء
icon كود لترحيل البيانات لاعمدة مختلفة الترتيبكود لترحيل البيانات لاعمدة مختلفة الترتيب | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 كنت قد وضعت موضوعاً جول الــServer لهذا المنتدي و انه في أغلب الأحيان 70% تظهر هذه العبارة على الــBrowser
This site can’t be reached  والان النسبة اصبحت 90%
ولاحياة لمن تنادي   اي لم يرد على تساؤلاتي من المسؤولين عن الموقع
لهذا اذا استمر هذا الوضع سأقوم (آسفاً) بتعليق عضويتي في الموقع

الكود من جديد (الصفحات الباقية ليست محذوفة بل تم اخفاءها
لمراقبة عمل الكود)

Sub My_Data()

Dim A, D    As Worksheet
Dim RD%, RA%, I%, K%
Dim Ar_A(), Ar_D()
Set A = Sheets("Atten")
Set D = Sheets("Daily ENT")
RD = D.Range("D7").Resize(500).Find("", LookIn:=xlValues).Row - 1
RA = A.Cells(Rows.Count, "D").End(3).Row + 1
If RA < 7 Then RA = 7
'-----------------------------------------------------
 Ar_A = Array("D", "E")
 Ar_D = Array("D", "C")

For K = 7 To RD
   For I = 0 To 1
      A.Cells(RA, Ar_A(I)) = _
      D.Cells(K, Ar_D(I))
   Next I
     A.Cells(RA, I + 4).Resize(, 7).Value = _
   D.Cells(K, "F").Resize(, 7).Value
 RA = RA + 1
Next K
End Sub

 
22-03-2021 01:34 مساء
icon كود لترحيل البيانات لاعمدة مختلفة الترتيب | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Sub My_Data()

Dim N, D    As Worksheet
Dim RD%, RN%, I%, K%
Dim Ar_N(), Ar_D()

Set N = Sheets("New")
Set D = Sheets("Data")

RD = D.Cells(Rows.Count, "C").End(3).Row
RN = N.Cells(Rows.Count, "D").End(3).Row + 1
If RN < 7 Then RN = 7
'-----------------------------------------------------
 Ar_N = Array("D", "E")
 Ar_D = Array("D", "C")

For K = 7 To RD
   For I = 0 To 1
      N.Cells(RN, Ar_N(I)) = _
      D.Cells(K, Ar_D(I))
   Next I
  
   N.Cells(RN, I + 4).Resize(, 7).Value = _
   D.Cells(K, "F").Resize(, 7).Value
 RN = RN + 1
Next K

End Sub


الملف مرفق
 
16-03-2021 06:45 صباحا
icon كود لنسخ بيانات من ملف اسمه ومساره غير ثابت الى ملف اخر | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود
يحدد لك عدد المصنفات المفنوحة ما عدا المصنف الرئيسي
و يفترض ان  الملف المصدر ( المراد النسخ منه ) هو أول واحد منها

Option Explicit

Sub How_Many_Opened_Books()
Dim P%, Other_Path$
Dim Coll As New Collection
Dim Main_Book As Workbook
Dim Other_Book As Workbook
    
    For P = 1 To Application.Workbooks.Count
     If Workbooks(P).Name <> ThisWorkbook.Name Then
       Coll.Add Workbooks(P).Name
     End If
    Next
 
 If Coll.Count = 0 Then Exit Sub
    Set Main_Book = ThisWorkbook
    Set Other_Book = Workbooks(Coll(1))
    MsgBox Other_Book.Name
    Other_Path = Other_Book.Path
    MsgBox Other_Path
End Sub


 
11-03-2021 09:44 صباحا
icon طلب مساعدة بخصوص طباعة من يوزر فوورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Application.Visible = False
هذه العبارة خطيرة جداً لانها تخفي الExcel بالكامل ولا تخفي الورقة كما تعتقد
عند استعمالها لا يمكنك رؤية برنامج الاكسل حتى ولو قمت بفتح مصنف جديد
اذن انت هنا تخفي الـــ Application التي هي الــ Excel فكيف تطلب الطباعة
15-02-2021 07:09 صباحا
icon استخراج الرقم الاقل | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Try This code

Option Explicit
Sub fin_min()
Dim arr(), m, i, Mn
    For i = 2 To 7
      If Cells(i, 1) < Cells(2, 3) Then
        ReDim Preserve arr(m)
        arr(m) = Cells(i, 1)
        m = m + 1
      End If
    Next
If m > 0 Then
    Mn = Application.Min(Application.Max(arr), Cells(2, 3))
    MsgBox Range("a2:a7").Find(Mn, lookat:=1).Address
End If
End Sub
12-02-2021 08:28 صباحا
icon بحث بالاسم في جميع الشيتات عن طريق اليوزر فورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الملف
qWKZo_My_User
08-02-2021 09:33 صباحا
icon طباعة الصفوف الثلاثة الأولى المخفية | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Try This Code

Option Explicit
Sub Hide_then_Print()
Dim LR%
 
 With Sheets("موازنة 2020")
   LR = .Cells(Rows.Count, 1).End(3).Row
  .Rows("1:3").Hidden = False
  .PageSetup.PrintArea = _
  .Range("A1:F" & LR).Address
  
  .PrintPreview             ' <<<==== Change to .PrintOut
  
  .Rows("1:3").Hidden = True
  End With
End Sub
31-01-2021 07:38 صباحا
icon دالة جمع البيانات بشرط أن تكون في حدود تاريخ معين أو ما قبله | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 this Formula

=SUMPRODUCT(($D$11:$D$38<=$F$3)*G$11:G$38)

 
26-01-2021 10:51 مساء
icon محتاج كود لشيت الطلاب فقط ادخال اختصار في خلايا العمود | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذا الماكرو

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C100")) Is Nothing _
 And Target.Count = 1 Then
  Select Case Target.Value
   Case 1:   Target = "ابتدائي"
   Case 2: Target = "اعدادي"
   Case Else: Target = Target
   End Select
 End If
 Application.EnableEvents = True
End Sub

الملف مرفق (تكتب 1 او  2 وتضغط  Enter/   tab / arrow/
او  تنتقل بالماوس الى خلية اخرى   او اي شيء اخر)
25-01-2021 07:19 مساء
icon كود للترحيل من شيت لاخر مع فلتره | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 زركشة ألوان فاقعة تبهر البصر
لا استطيع العمل على هكذا ملف

الصفحة 3 من 65 < 1 2 3 4 65 > الأخيرة »





الساعة الآن 12:57 صباحا

أعلن هنا
أعلن هنا
أعلن هنا