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


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


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


نتائج البحث عن ردود العضو :ابراهيم الحداد
عدد النتائج (60) نتيجة
10-08-2018 01:30 مساء
icon اصلاح وتفعيل كود به معادلة | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
تعديل طفيف فى الكود لا يكاد يذكر
اليك الكود بعد التعديل
Sub FormulaCopy()
Range("F6:IE560").Formula = "=IF(AND(COUNTIF('التقرير اليومي'!$C$63:$I$102,$B6)=1,COUNTIF('التقرير اليومي'!$N$61,F$5)=1),""غ"","""")"
Sheets("التقرير اليومي").Activate
Range("c63:J102").ClearContents
MsgBox "Done...", 64
End Sub
12-06-2018 12:47 صباحا
icon ترحيل الى الشيت الثاني بدون تكرار | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
بارك الله فيكما اخواى الكريمين
و كل عام وانتم بخير

 
12-06-2018 12:02 صباحا
icon ترحيل الى الشيت الثاني بدون تكرار | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ضع الكود الاول فى موديول عادى
Sub Trans()
Dim ws As Worksheet, Sh As Worksheet
Dim C As Range, x As Integer, p As Integer
Set ws = Sheets("ورقة1")
Set Sh = Sheets("ورقة2")
p = 6
For Each C In ws.Range("A7:A19")
x = WorksheetFunction.CountIf(ws.Range("A7:A" & C.Row), C)
If x = 1 Then
p = p + 1
Sh.Cells(p, 1) = C.Value
Sh.Cells(p, 2) = C.Offset(0, 1).Value
End If
Next
End Sub


اما الكود الثانى فضعه فى حدث الورقة 2
Private Sub Worksheet_Activate()
Call Trans
End Sub


 
02-06-2018 02:25 صباحا
icon قاموس عربى -انجليزى على الإكسيل | الكاتب :ابراهيم الحداد |المنتدى: اكسيل شروحات ودروس
 السلام عليكم ورحمة الله
و كل عام و انتم بخير
شكرا جزيلا لك و بارك الله فيك
30-05-2018 02:25 مساء
icon اصلاح كود استخراج البيانات من رقم العميل وكود الصنف فى الفورم | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
كل عام وانتم بخير
استخدم هذين الكودين
Private Sub ComboBox1_Change()
Dim ws As Worksheet
Set ws = Sheets("الاصناف والعملاء")
Me.TextBox4.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("G3:J12"), 2, 0)
Me.TextBox5.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("G3:J12"), 3, 0)
Me.TextBox6.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("G3:J12"), 4, 0)
End Sub
Private Sub ComboBox2_Change()
Set ws = Sheets("الاصناف والعملاء")
Me.TextBox87.Value = WorksheetFunction.VLookup(Val(Me.ComboBox2.Value), ws.Range("B3:D12"), 2, 0)
Me.TextBox10.Value = WorksheetFunction.VLookup(Val(Me.ComboBox2.Value), ws.Range("B3:D12"), 3, 0)
End Sub

30-05-2018 01:52 مساء
icon كيف امنع المكرو من تنفيذ الامر في حالة الغاء واترجع فهو يتم الباقي امل تصحيح الكود ياكرام امل تص | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
كل عام وانتم بخير
اجعل الكود بهذا الشكل
Sub Macro01()
a = MsgBox("هل  تريد طباعة الان  ؟", vbYesNo + vbQuestion, "طباعة")
' اذ اخترت لا اريد الطباعة الصحيح الكود يقف ويلغي التنفيذ هنا
If a = vbNo Then
Exit Sub
Else
With ActiveSheet
Dim Numcop As Integer
         Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
     ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
End With
End If
  Dim X3 As Long, X4 As Long
X3 = Sheets("DATA").Range("a1000").End(xlUp).Row + 1
X4 = Sheets("aaa").Range("B24").End(xlUp).Row
   Sheets("DATA").Range("B" & X3).Resize(X4 - 5, 21) = Sheets("aaa").Range("B6").Resize(X4 - 5, 21).Value
End Sub

30-05-2018 01:44 مساء
icon أرجوا النظر في سؤال لي قديم في المنتدى | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
كل عام وانتم بخير
استخدم هذا الكود ربما يفيدك
Sub DelRows()
Dim ws As Worksheet, C As Range
For Each ws In Worksheets
For Each C In ws.Range("A4:A23")
On Error Resume Next
If ActiveCell.Value = C.Value Then
C.EntireRow.Delete
End If
Next
Next
End Sub

06-05-2018 01:36 صباحا
icon كيف ينفذ  ميكرو بضغط  ويفتح صفحة ويب من خليه فيها معادله امل المساعدة ياكرام. | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود ربما يفيدك
Sub Con_WebSite()
ThisWorkbook.FollowHyperlink Address:=Sheet1.Range("G2"), NewWindow:=True
End Sub

05-05-2018 01:46 مساء
icon مشكلة في الهايبرلينك | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اخى الكريم  خالد
هذه المشكلة و المتمثلة فى رسالة الهايبر لينك عانيت منها منذ اكثر من شهرين و حقيقة لم تشغلنى كثيرا
و لكن فى الفترة الاخيرة بدأت ابحث جديا عن الحل و علمت انه بسبب مشكلة ما فى المتصفحات التى نستخدمها لتصفح الانترنت
و بالفعل توصلت الى حل من خلال احد المواقع الاجنبية و اليك رابط هذا الموقع
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

ارجو المعذرة فى حالة وجود خلل فى الرابط و خاصة انها اول مرة استخدم فيها رابط خارجى فى احد موضوعاتى
هذا والله الموفق و المستعان
05-05-2018 12:50 صباحا
icon حذف صف بناء على قيمة خلية فى الصف | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub DelRows()
Dim LR As Long, i As Long
Dim ws As Worksheet
Set ws = Sheets("ورقة1")
LR = ws.Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 7 Step -1
If ws.Cells(i, 4).Value = "معاش" Then
ws.Cells(i, 4).EntireRow.Delete
End If
Next
End Sub

27-04-2018 01:47 صباحا
icon ترتيب الاوائل | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub ExceT2()
Dim ws As Worksheet, Sh As Worksheet
Dim x As Integer, R As Long, i As Integer, y As Integer
Dim LS As Long, z As Integer
Dim st As String
Set ws = Sheets("Main")
Set Sh = Sheets("First_All1")
Sh.Range("C11:H20").ClearContents
M = 10
LR = ws.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For R = 14 To LR
On Error Resume Next
x = WorksheetFunction.Rank(ws.Range("CZ" & R), ws.Range("CZ14:CZ" & LR))
If x <= 10 Then
M = M + 1
Sh.Cells(M, 4) = ws.Cells(R, 10)
Sh.Cells(M, 5) = ws.Cells(R, 2)
Sh.Cells(M, 6) = ws.Cells(R, 3)
Sh.Cells(M, 7) = ws.Cells(R, 104)
Sh.Cells(M, 3) = (M - 10)
End If
Next
LS = Sh.Range("G" & Rows.Count).End(xlUp).Row
For i = 11 To LS
y = WorksheetFunction.Rank(Sh.Range("G" & i), Sh.Range("G11:G" & LS))
z = WorksheetFunction.CountIf(Sh.Range("G11:G" & i), Sh.Range("G" & i))
If y < 1 Or y > 10 Then Exit Sub
st = Choose(y, "الاول", "الثانى", "الثالث", "الرابع", "الخامس", _
"السادس", "السابع", "الثامن", "التاسع", "العاشر")
If z > 1 Then
Sh.Range("H" & i) = st & " " & "مكرر"
Else
Sh.Range("H" & i) = st
End If
Next
Application.ScreenUpdating = True
End Sub



26-04-2018 01:39 صباحا
icon ترحيل حسب الشهر | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
جرب هذا الكود
Sub Tarhil1()
Application.ScreenUpdating = False
Dim sh As Worksheet
LR = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For Each sh In ThisWorkbook.Worksheets
For R = 2 To LR
y = Year(Cells(R, 1))
m = Month(Cells(R, 1))
If Len(m) = 1 Then
m = "0" & m
Else
m = m
End If
ym = m & "-" & y
If sh.Name = "Sheet1" Then GoTo 2
If Cells(R, 1).Value <> Empty Then
If ym = sh.Name Then
Range(Cells(R, 1), Cells(R, 3)).Copy
QQ = sh.Cells(1000, 1).End(xlUp).Row + 1
sh.Range("A" & QQ).PasteSpecial xlPasteValues
End If
End If
Next
2
Next
Application.CutCopyMode = False
Sheet1.Activate
Range("b5").Select
Application.ScreenUpdating = True
End Sub


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





الساعة الآن 04:24 مساء

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