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

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




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

Preview

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


نتائج البحث عن ردود العضو :حسين مامون
عدد النتائج (129) نتيجة
19-02-2021 08:12 مساء
icon تعديل على فاتورة | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 جرب ربما يكون قريب مما تريد
16-02-2021 11:14 صباحا
icon يوزر فورم باسورد بدون زر | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 ربما تقصد ما في هذه المشاركة






06-02-2021 01:30 مساء
icon مع أكاديمية الصقر اخفي أكوادك وعيش حياتك EvilClippy VBA Project Unviewable Protection | الكاتب :حسين مامون |المنتدى: موضوعات ياسر خليل أبو البراء
 بارك الله فيك وزادك من فضله
 
06-02-2021 12:04 مساء
icon دمج كودين | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 هذا مثال عن دمح كودين في حدث Private Sub Worksheet_Activate()
Sub test1()
Dim LR
Dim WS As Worksheet
Set WS = Sheets("data")
LR = WS.Cells(Rows.Count, 1).End(3).Row + 1
WS.Range("a" & LR).Value = 2021

End Sub
'====================


Sub test2()
Dim LR
Dim WS As Worksheet
Set WS = Sheets("data")
LR = WS.Cells(Rows.Count, 2).End(3).Row + 1
WS.Range("b" & LR).Value = Date

End Sub



وهنا  دمجهما
Private Sub Worksheet_Activate()
test1
test2
End Sub

02-02-2021 12:34 مساء
icon شيت أجمالى بكل الحركات | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود
Sub Envoier_DO()
Dim SH As Worksheet
Dim ws As Worksheet
Dim lr1, lr2
Set ws = Sheets("المجمع")
Application.ScreenUpdating = False
ws.Range("b4:i1000000").ClearContents
For Each SH In Sheets
If SH.Name <> "المجمع" Then
  lr1 = ws.Range("b" & Rows.Count).End(xlUp).Row + 1
    lr2 = SH.Range("b" & Rows.Count).End(xlUp).Row
    SH.Range("b4:i" & lr2).Copy ws.Range("b" & lr1)
End If
Next SH
Application.ScreenUpdating = True

End Sub
02-02-2021 12:14 مساء
icon البحث عن قيمة خلية بمرجع خلية اخرى | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 بعد اذن استادي ابراهيم الحداد 
و اتراء للموضوع
جرب هذا الكود لعله يفيدك
 
29-01-2021 06:44 مساء
icon مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 الحمد لله ان تم الامر كما تريد
المهم تفهم الكود وتتعلم لتقوم باي تعديل بنفسك
 
29-01-2021 05:57 مساء
icon مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 ربما تقصد هذا التعديل في الماكرو
Sub Macro9()
   Application.DisplayAlerts = False
 Application.ScreenUpdating = False
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(2)
Dim RG As Range: Set RG = ws.Range("F25")
Dim NM As Range: Set RG = ws.Range("F21")
Dim wb As Workbook
Dim wbs As Worksheet
Set wb = Workbooks.Open(ThisWorkbook.Path & "\file2.xlsm", True, , True, Password:="123")
Set wbs = wb.Sheets(1)
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row + 1
wbs.Range("b" & lr).Value = RG
wbs.Range("a" & lr) = wbs.Range("a" & lr - 1) + 1
wbs.Range("b" & lr).Offset(, 1) = Date
wbs.Range("b" & lr).Offset(, 2) = Time
wbs.Range("b" & lr).Offset(, 3) = Date + Time
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row
ws.Range("F21").Value = wbs.Range("a" & lr).Value
wb.Save
wb.Close

Range("F25").Select
Application.DisplayAlerts = True
Application.CutCopyMode = True

End Sub

 
29-01-2021 01:36 مساء
icon ظهور القيم في مربع النص عند تحديد خلية vba | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 وجزيت خيرا اخي الكريم
28-01-2021 07:19 مساء
icon ظهور القيم في مربع النص عند تحديد خلية vba | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 انسخ هذا الكود مكان السابق
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
    ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
    Selection.Text = Target
    Target.Select
End Sub
28-01-2021 06:20 مساء
icon ظهور القيم في مربع النص عند تحديد خلية vba | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 ربما تقصد هذا الشيء
 
21-01-2021 12:11 مساء
icon مساعده فى ليست بوكس | الكاتب :حسين مامون |المنتدى: اكسيل اسئله واجابات
 كود لطباعة الفاتورة
Sub prin_FATORA()
Dim lr, X
Dim ws As Worksheet
Set ws = Sheets("الفاتورة")
Application.ScreenUpdating = False
If MsgBox("هل تريد طباعة الفاتورة", vbExclamation + vbYesNo) = vbYes Then
With ws
For X = 13 To 41
If .Cells(X, "f") = "" Then
.Cells(X, "a").EntireRow.Hidden = True
End If
Next X
'=================
.Range("b1:h45").PrintPreview
End With
End If
ws.Range("a13:a41").EntireRow.Hidden = False
Application.ScreenUpdating = True

End Sub

وهذا فى حدث الفورم
Private Sub UserForm_Activate()
Dim k, c, lr
Dim ws As Worksheet
Set ws = Sheets("Main")
ListBox1.Clear
ListBox1.ColumnCount = 4
With ws
lr = .Cells(Rows.Count, 1).End(3).Row
k = 0
For Each c In .Range("a14:a" & lr)
ListBox1.AddItem
ListBox1.List(k, 0) = .Cells(c.Row, 1).Value
ListBox1.List(k, 1) = .Cells(c.Row, 2).Value
ListBox1.List(k, 2) = .Cells(c.Row, 3).Value
ListBox1.List(k, 3) = .Cells(c.Row, 4).Value
k = k + 1


Next c
End With
End Sub
 

 
Private Sub UserForm_Activate() Dim k, c, lr Dim ws As Worksheet Set ws = Sheets("Main") ListBox1.Clear ListBox1.ColumnCount = 4 With ws lr = .Cells(Rows.Count, 1).End(3).Row k = 0 For Each c In .Range("a14:a" & lr) ListBox1.AddItem ListBox1.List(k, 0) = .Cells(c.Row, 1).Value ListBox1.List(k, 1) = .Cells(c.Row, 2).Value ListBox1.List(k, 2) = .Cells(c.Row, 3).Value ListBox1.List(k, 3) = .Cells(c.Row, 4).Value k = k + 1 Next c End With End Sub
 

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





الساعة الآن 07:51 صباحا

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