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

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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز
المشرف المتميز
المراقب المتميز
المدير المتميز
الموضوع المتميز
القسم المتميز
رمضان بكري Eslam Abdullah لا تميز خلال هذه الفترة YasserKhalil تجميعة أكواد VBA بشكل حصري ومجاناً لمنتدى أكاديمية الصقر اكسيل اسئله واجابات



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


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


نتائج البحث عن ردود العضو :ابراهيم الحداد
عدد النتائج (80) نتيجة
20-02-2019 12:10 صباحا
icon جمع الدرجات وترحليها إلي الشهادة المدرسية | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اخى الكريم هذا الكود يخص جمع درجات المواد و المجموع الكلى
Sub SumSubjs()
Dim ws As Worksheet
Dim LR As Long, i As Long, j As Long
Dim x As Double, Sums As Double
Set ws = Sheets("Ã.3Ã")
LR = ws.Range("D" & Rows.Count).End(xlUp).Row
For j = 12 To LR
i = 7
Do While i <= 37
x = Cells(j, i - 2) + Cells(j, i - 1)
Cells(j, i) = x
Sums = Sums + Cells(j, i)
i = i + 3
Loop
Cells(j, 38) = Sums
Sums = 0
Next
End Sub
19-02-2019 01:41 مساء
icon استدعاء صفوف من قاعدة بيانات بناء على قيمة خلية | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub TraData()
Dim Sh As Worksheet, ws As Worksheet, C As Range
Set Sh = Sheets("Data")
Dim LR As Long, i As Long, j As Long, x As Long
Set ws = Sheets("Report")
LR = Sh.Range("B" & Rows.Count).End(xlUp).Row
i = 6
j = 20
x = 34
For Each C In Sh.Range("B2:B" & LR)
If C.Value = ws.Range("D1").Value And C.Offset(0, 2) = "Completed " Then
i = i + 1
ws.Cells(i, "B") = C.Offset(0, 3)
ws.Cells(i, "C") = C.Offset(0, 2)
ws.Cells(i, "D") = C.Offset(0, 4)
ws.Cells(i, "E") = C.Offset(0, 5)
ws.Cells(i, "F") = C.Offset(0, 6)
ws.Cells(i, "G") = C.Offset(0, 7)
ws.Range("D2").Value = C.Offset(0, 1)
ElseIf C.Value = ws.Range("D1").Value And C.Offset(0, 2) = "Pending" Then
j = j + 1
ws.Cells(j, "B") = C.Offset(0, 3)
ws.Cells(j, "C") = C.Offset(0, 2)
ws.Cells(j, "D") = C.Offset(0, 4)
ws.Cells(j, "E") = C.Offset(0, 5)
ws.Cells(j, "F") = C.Offset(0, 6)
ws.Cells(j, "G") = C.Offset(0, 7)
ws.Range("D2").Value = C.Offset(0, 1)
ElseIf C.Value = ws.Range("D1").Value And C.Offset(0, 2) = "Rejected" Then
x = x + 1
ws.Cells(x, "B") = C.Offset(0, 3)
ws.Cells(x, "C") = C.Offset(0, 2)
ws.Cells(x, "D") = C.Offset(0, 4)
ws.Cells(x, "E") = C.Offset(0, 5)
ws.Cells(x, "F") = C.Offset(0, 6)
ws.Cells(x, "G") = C.Offset(0, 7)
ws.Range("D2").Value = C.Offset(0, 1)

End If
Next

07-02-2019 07:15 مساء
icon اضافة رقم الشيت واسمه فى الرئيسية عند فتح شيت اكسل جديد | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ضع هذا الكود فى حدث ورقة " الرئيسى "
مع مراعاة ترتيب الورقة الجديدة فى نهاية الاوراق السابقة
Private Sub Worksheet_Activate()
Dim i As Integer
Dim ws As Worksheet
i = 2
For Each ws In Worksheets
If ws.Name <> "الرئيسى" Then
i = i + 1
Cells(i, 1) = ws.Index - 1
Cells(i, 2) = ws.Range("G1").Value
End If
Next
End Sub
20-01-2019 07:17 مساء
icon كيف اجعل الكود يتم ادراجة على كل الاوراق الحالية والمستقبلية | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اجعل الكود هكذا
Sub Macro2()
Dim Sh As Worksheet
For Each Sh In Worksheets
If Sh.Name <> "DATA" Then
   Sh.Range("K2").FormulaR1C1 = "=HYPERLINK(""#'DATA'!D1"",""GO DATA"")"
End If
Next
End Sub

29-12-2018 12:33 مساء
icon جلب الصور | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اخى الكريم يجب يكون اسم الصورة هو نفس رقم المريض و الامتداد يكون "JPG"
اليك الملف
 
29-12-2018 12:09 صباحا
icon جلب الصور | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم الكودين الآتيين
الاول يوضع فى موديول عادى اما الثانى فيوضع فى حدث الورقة المسماة البيانات
Sub AddPics()
Dim ws As Worksheet, pic As Object
Dim Pth As String, XName As String, FPic As String
For Each pic In ActiveSheet.Pictures
pic.Delete
Next pic
Set ws = Sheets("البيانات")
XName = ws.Range("B4").Value
FPic = "مجلد الصور"
On Error GoTo 1
Pth = ActiveWorkbook.Path & "" & FPic & "" & XName
ActiveSheet.Shapes.AddPicture Filename:=Pth & ".jpg", linktofile:=msoFalse, _
savewithdocument:=msoTrue, Left:=190, Top:=90, Width:=110, Height:=110
1:
Exit Sub
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$4" Then Exit Sub
Call AddPics
End Sub


ملحوظة هامة :
قم بازالة اداة الصورة المدرجة فى الورقة
24-12-2018 09:11 مساء
icon شيت كنترول الصف الثانى التجارى | الكاتب :ابراهيم الحداد |المنتدى: اكسيل شروحات ودروس
 السلام عليكم ورحمة الله
اخى الكريم عمرو
طلبك على هذا الرابط
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
27-11-2018 12:57 مساء
icon حساب السن | الكاتب :ابراهيم الحداد |المنتدى: اكسيل شروحات ودروس
 السلام عليكم اخى الكريم هشام
اليك الملف و به التاريخ المذكور بالمشاركة
و تم فيه حساب السن بدقة
 
18-11-2018 02:10 مساء
icon ناتج الخليه نص كيف يمكن ادخاله بصيغه | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اجعلها هكذا
=SUM(INDIRECT(B3&":"&D3))
15-11-2018 11:27 صباحا
icon نسخ البيانات الى صفحات مختلفة | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استبدل هذه العبارة :
ws.Range("C5:D" & ws.Range("C" & Rows.Count).End(xlUp).Row).Copy 

بهذه العبارة :
Selection.Copy
15-11-2018 11:18 صباحا
icon تعديل الكود_ليصبح نسخ البيانات فى الشيتات بدون فراغات | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub Rectangle1_Click()
Dim i As Integer, j As Integer, p As Integer
p = 4
For i = 5 To Worksheets("تكويد_بيانات").Range("A5000").End(xlUp).Row
If Not IsEmpty(Worksheets("تكويد_بيانات").Range("A" & i)) Then
p = p + 1
Worksheets("رصيد_الصنف").Range("A" & p) = Worksheets("تكويد_بيانات").Range("A" & i)
Worksheets("رصيد_الصنف").Range("B" & p) = Worksheets("تكويد_بيانات").Range("B" & i)
End If
Next

p = 6
For i = 5 To Worksheets("تكويد_بيانات").Range("C5000").End(xlUp).Row
If Not IsEmpty(Worksheets("تكويد_بيانات").Range("C" & i)) Then
p = p + 1
Worksheets("رصيد_المورد").Range("A" & p) = Worksheets("تكويد_بيانات").Range("C" & i)
End If
Next

p = 6
For i = 5 To Worksheets("تكويد_بيانات").Range("D5000").End(xlUp).Row
If Not IsEmpty(Worksheets("تكويد_بيانات").Range("D" & i)) Then
p = p + 1
Worksheets("رصيد_العميل").Range("A" & p) = Worksheets("تكويد_بيانات").Range("D" & i)
End If
Next
End Sub
14-11-2018 10:43 مساء
icon اكسل:- | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ضع الكود الاول فى موديول
و الكود الثانى فى حدث الورقة الاولى
يعمل الكود بالضغط مرتين على الخلية ( دوبل كليك)
 الكود الاول :
Sub SelRng()
Dim X As Integer, Y As Integer
Dim Arr() As String, C As Variant
If ActiveSheet.Name = "Sheet1" Then
X = ActiveCell.Row
Y = ActiveCell.Column
End If
If X > 0 And Y > 0 Then
Sheet2.Activate
Sheet2.Cells(X, Y).Select
End If
End Sub


الكود الثانى :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call SelRng
End Sub

 

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





الساعة الآن 11:28 مساء

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