محمود الحربي

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

اخواني الأعزاء اريد مساعدة في هذا الكود لجعله يبحث عن أي حرف لو في منتصف ا لخلية 

Quote

Private Sub TextBox1_Change()
On Error Resume Next
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
ListBox1.Visible = True
Dim WS As Worksheet
Dim V As Integer
Dim LastRow As Integer
Dim M As String
Dim Q, F
ListBox1.Clear
If TextBox1.Text = "" Then GoTo 1
M = TextBox1.Text
Set WS = Sheets("ورقة1")
With WS
 LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Q = .Range("B2:B" & LastRow).Find(M)
If Not Q Is Nothing Then
F = Q.Address
Do
If Application.WorksheetFunction.Search(M, Q, 1) = 1 Then
ListBox1.AddItem Q.Value
ListBox1.List(V, 0) = Q.Offset(0, 3).Value
ListBox1.List(V, 1) = Q.Offset(0, 2).Value
ListBox1.List(V, 2) = Q.Offset(0, 1).Value
ListBox1.List(V, 3) = Q.Offset(0, 0).Value
ListBox1.List(V, 4) = Q.Offset(0, -1).Value
 V = V + 1
TextBox2.Value = ListBox1.ListCount
 End If
Set Q = .Range("B2:B" & LastRow).FindNext(Q)
 Loop While Not Q Is Nothing And Q.Address <> F
 End If
End With
1 End Sub

للرفع

اتمني احد من الاخوان المساعدة

تعبيئة النموذج.rar

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

دالة لربط ملف في مجلد معين حسب اسم الملف في الخلية

لدي دالة لم تنجح

Quote

=HYPERLINK("C:\Users\Mahmoud Ahmed\Desktop\MAS="&B7&"";"فتح المعاملة")

المصنف1.rar

هل يوجد احد من الأساتذة يساعدني في هذا الكود

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

يا اخواني واساتذتي الاعزاء

لدي معادلة تعمل على الخلايا في الشيت  بشكل ممتاز

ولاكن حبيت استخدم فورم ولم تنفع معاي ابداً

المعادلة

Quote

=IF(OR(ISBLANK($AL11); ISBLANK($AM11));"";HYPERLINK("http://maps.google.com/maps?f=d&saddr=&daddr="&$AL11&","&$AM11;"فتح الموقع على الخرائط "))

لو فيه طريقة او كود يخدمني فيه احد الزملاء والأساتذة الكرام

رحم الله والدينا والدينكم

اضافة زر للانتقال الى موقع قوقل ماب والبحث بالاحداثية.rar

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

اخواني واساتذتي الأعزاء

لدي فورم اريد وضع زر للانتقال حسب البيان

مرفق مثال يوضح لكم المطلوب

اذا احد يقدر يساعدني فيه

غفر الله لكم ولوالدينا جميعاً

فورم ادخال و تعديل مرن بمعية فورم ادخال التاريخ2.rar

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

سعدت جداً من الأخ والأستاذ عبدالله بعمل فورم افادني جداً

لكني احتاج مساعدة من الاخوان  او من استاذنا عبدالله

في إضافة زر الانتقال للخرائط حسب ما هو موضح في المثال المرفق

كما لو اردت إضافة أعمدة ممكن تشرح لنا الطريقة

شكراً اخي واستاذي على ما تقدمة لنا

رحم الله والدينا والدينكم

فورم ادخال و تعديل مرن بمعية فورم ادخال التاريخ2.rar

انتظر شخص يساعدني لو بالطريقة ابداء المشوار

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

اخواني الأعزاء اريد مساعدة في مثال الى فورم بحث وتعديل وطباعة

مرفق مثال ياليت احد يدلني على الطريق

رحم الله والدينكم والدينا

الاتصالات الادارية.rar

بالنسبة للطباعة النهائية عملتها لك على السريع

وان شاء الله الاخوان ما يقصروا

واذا حصلت لي فرصة غداً بخدمك فيها

ط¨ظٹط§ظ†ط§طھ ط§ظ„ظ…ظˆط¸ظپ.rar

بن علية حاجي

شكرا لك واسعدك الله دنيا واخره

يظهر لون الكتابة في المشاركة اعلى باللون الأبيض

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

تصادفني مشلكة في  الطباعة بعد اختيار المسلسل للبيانات واريد طباعتها على النموذج في الشيت 2

لا بد من الذهاب للشيت 2 والضغط على اي خليه ليتم تحديث البيانات وهذا يسبب مشكلة لدي هل هناك حل

المثال فيه توضيح اكثر 

رحم الله والديني والدينكم وغفر لهم

درس النموذج.rar

السلام عليكم

اخواني اريد مساعد في المثال هذا ( الصورة للمثال فقط )

اريد لما اطبع البيانات يطبع النموذج الي في الصورة

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

واعيد النموذج للطابعة واطبع البيانات

شاكر ومقدر لكم

ورحم الله والدينا والدينكم

نموذج طباعة.rar

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

 مساعدة في تكرار الاسماء بعد الفلتره

يوجد مثال في المرفقات

رحم الله والديكم 

مثال.rar

رحم الله والدينك ورزقك الذرية الصالحة

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

لدي عدد كبير من الاحداثيات يتجاوز 4000 احداثية تم تضعها في ملف اكسل بهذا الشكل المعروض 

واحتاج وضع رابط لهم للانتقال للموقع في المحدد في الاحداثية

الاحداثيات.rar

مرفق لك صورة عند الطباعة

هناك خيار لدمج كل الصفوف والاعمدة في صفحة واحدة

1.rar

Quote

Private Sub CommandButton1_Click()

Dim myrng As Range, cel As Range, x As Double

Set myrng = Range("A1:A18") 'ããßä ÇáÊÛííÑ
myrng.Value = ""
If myrng.Count > 18 Then Exit Sub
Randomize
For Each cel In myrng
1 x = WorksheetFunction.RandBetween(1, 18)
If Application.CountIf(myrng, x) Then GoTo 1 Else cel = x
Next

End Sub

Private Sub CommandButton2_Click()

Dim myrng As Range, cel As Range, x As Double

Set myrng = Range("A19:A36") 'ããßä ÇáÊÛííÑ
myrng.Value = ""
If myrng.Count > 18 Then Exit Sub
Randomize
For Each cel In myrng
1 x = WorksheetFunction.RandBetween(19, 36)
If Application.CountIf(myrng, x) Then GoTo 1 Else cel = x
Next

End Sub

Private Sub CommandButton3_Click()

Dim myrng As Range, cel As Range, x As Double

Set myrng = Range("A37:A63") 'ããßä ÇáÊÛííÑ
myrng.Value = ""
If myrng.Count > 27 Then Exit Sub
Randomize
For Each cel In myrng
1 x = WorksheetFunction.RandBetween(37, 63)
If Application.CountIf(myrng, x) Then GoTo 1 Else cel = x
Next

End Sub

او حل اخر كيف اقدر اخليه يأخذ بس الأرقام الي في العامود

C

ويوزعها على في العامود

A

بالكود السابق

Quote

جرب الكود بهذا الشكل

Private Sub CommandButton4_Click()
    Dim lastRow     As Long
    Dim i           As Long
    
    lastRow = Range("C" & Rows.Count).End(xlUp).Row
    
    For i = lastRow To 1 Step -1
        If Cells(i, "D").Value = "" Then
            Cells(i, "C").Resize(, 2).Delete xlUp
        End If
    Next i
End Sub

نفس المشكلة يحذف الخلية المجاورة الي هي رقم المتسلسل

Quote

Private Sub CommandButton4_Click() Dim lastRow As Long Dim i As Long lastRow = Range("C" & Rows.Count).End(xlUp).Row For i = lastRow To 1 Step -1 If Cells(i, "D").Value = "" Then Cells(i, "D").Resize(, 2).Delete xlUp End If Next i End Sub