Ahmed_J

استاذي العزيز 

اين المرفقات؟؟؟

السلام عليكم

مشاركة مع استاذي  ازهر

اخي العزيز  اول شيء لابد ان اسماء الدول لاتتكرر في القائمة بالنموذج وكذلك اسماء المدن  حتلى تسهل عملية الفرز

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

تفضل  الملف بعد التعديل حسب طلبك وفهمي للموضوع

=DSum("totaly";"q";"country=[a] and city=[b] and village=[c]")

ونستطيع اضافة لها NZ  للتحويل القيمة الفارغة الى صفر

=Nz(DSum("totaly";"q";"country=[a] and city=[b] and village=[c]");0)

ddsum.accdb

مرفق مثال توضيحي للقوائم المرتبطة

تحياتي

قائمة منسدلة متربطة بقائمة اخرى.accdb

وعليكك السلام

تفضل هذا الرابط  اتمنى يكون المطلوب

اخي العزيز 

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

مع معرفة القيمة هل رقم ام نص او تاريخ

رقم
DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 =" & myWhere)

نص
DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 ='" & myWhere & "'") 

تاريخ
DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 = #" & myWhere & "#")

اخي العزيز

مع ان ليس لدي طابعة

الملف يعمل لدي بصورة صحيحة بدون مشاكل على الطابعة الافتراضية للوندوز

اتمنى احد الاخوة  ان يجد الحل لك

تحياتي

السلام عليكم

يوضع بزر في النموذج

DoCmd.SelectObject acReport, "CHEMM", True
DoCmd.PrintOut , 1, 1, , 1

جرب هذا المرفق

تحياتي

test.accdb

السلام عليكم

جرب الكود بعد تغيير اسم التقرير تبعك

DoCmd.SelectObject acReport, "TAB01", True
DoCmd.PrintOut , 1, 1, , 1

اخي  العزيز بالخدمة

اتدلل اخوي العزيز

بالخدمة

تغضل اخي الكريم

IQ.accdb

اخي العزيز

من الافضل ارفاق ملف حتى لو بسيط يشبة ملفك للتعديل

السلام عليكم

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

لكي نعطيك مثال عن ذلك

انظر للرابط 

https://www.officena.net/ib/topic/74860-إنشاء-دروس-vba-أكسس/

انظر للرابط اتمنى ان تستفيد منه 

تفضل 

1- قمت بتغيير المسميات في الجدول الى اللغة الانكليزية لسهولة التعامل معها مستقبلا في الاكواد

2- عملت لك استعلام لسهولة اجراء العمليات الحسابية فية او الفرز او اي شيء اخر

3- عملت لك نموذجين واحد نموذج منفرد والاخر نموذج مستمر (انت اختار اللي يعجبك منهم)

4- عملت لك تقرير 

تحياتي

test.accdb

السلام عليكم

اخي العزيز يمكن عمل ذلك  لان برنامج الاكسس رائع

المهم انك تعرف طريقة التعامل معة

تفضل الملف البسيط  مثل ملف الاكسل تبعك

test.accdb

بارك الله فيك استاذ @أبوبسمله

شكرا لكم اساتذتي الاعزاء

وفقكم الله

شكرا لك أستاذ @jjafferr

تعبتك معي كتير

قصدي توسيط مثل الصورة

بارك الله فيك

شكرا لك استاذ @jjafferr

بارك الله فيك

في مثل عندنا يقول (صاحب الحاجة اعمى)

1- هل يمكن توسيط  الكتابة داخل حقول الاسم والعمر والمهنة ام لا

2- في الكود رقم (4+) ورقم (20*)  هل ممكن توضح فائدتهم  لي اكثر 

 H = (Me.Ev.FontSize + 4) * 20

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

تحياتي للجميع

1468.1.Lines in Report.accdb

العفو استاذ @jjafferr  انت بتستاهل اكثر من هيك والله

اخر طلب منك الله يبارك فيك

كيف اقدر اتحكم بارتقاع حقل التقييم (EV)  بالتقرير  rpt_Ev  (انقاص از زبادة الارتفاع)

لان عندما غيرت الارتفاع  الى 1 سم من التنسيق الحقول تلخبط حقل التقييم كما في الصورة

تحياتي

الى الاستاذ @jjafferr 

إلى منارة العلم والمعرفة، اشكرك شكراً جزيلاً بعدد ألوان الزهور وقطرات الندى على مجهوداتك الكبيرة التي لا تتوقف لأجل تحقيق التميز والتقدم.

بارك الله فيك وجعلها في ميزان حسناتك

الله يوفقك وينير لك طريقك يارب العالمين.

هل الوحدة النمطية mod_Draw_Box_Lines احذفها لان ليس لها دور ام لا ؟؟؟

استاذي العزيز

تستطيع عمل ذلك من خلال وضع الكود اما بالاستعلام او مصدر بيانات الحقل بالنموذج

=NoToTxt([المبلغ];"جنيه";"قرش")

تحياتي للجميع

Database1.accdb

السلام عليكم

تفضل الكود  وهو لاحد الاخوة بالموقع  انسخة في وحدة نمطية

وبصراحة لااعرف عملة القرش 

Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String
Dim MyArry1(0 To 9) As String
Dim MyArry2(0 To 9) As String
Dim MyArry3(0 To 9) As String
Dim MyNo As String
Dim GetNo As String
Dim RdNo As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetTxt As String
Dim Mybillion As String
Dim MyMillion As String
Dim MyThou As String
Dim MyHun As String
Dim MyFraction As String
Dim MyAnd As String
Dim i As Integer
Dim ReMark As String


If TheNo > 999999999999.99 Then Exit Function


If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If

MyAnd = " و"
MyArry1(0) = ""
MyArry1(1) = "مائة"
MyArry1(2) = "مائتان"
MyArry1(3) = "ثلاثمائة"
MyArry1(4) = "أربعمائة"
MyArry1(5) = "خمسمائة"
MyArry1(6) = "ستمائة"
MyArry1(7) = "سبعمائة"
MyArry1(8) = "ثمانمائة"
MyArry1(9) = "تسعمائة"

MyArry2(0) = ""
MyArry2(1) = " عشر"
MyArry2(2) = "عشرون"
MyArry2(3) = "ثلاثون"
MyArry2(4) = "أربعون"
MyArry2(5) = "خمسون"
MyArry2(6) = "ستون"
MyArry2(7) = "سبعون"
MyArry2(8) = "ثمانون"
MyArry2(9) = "تسعون"

MyArry3(0) = ""
MyArry3(1) = "واحد"
MyArry3(2) = "اثنان"
MyArry3(3) = "ثلاثة"
MyArry3(4) = "أربعة"
MyArry3(5) = "خمسة"
MyArry3(6) = "ستة"
MyArry3(7) = "سبعة"
MyArry3(8) = "ثمانية"
MyArry3(9) = "تسعة"
'======================

GetNo = Format(TheNo, "000000000000.00")

i = 0
Do While i < 15

If i < 12 Then
MyNo = Mid$(GetNo, i + 1, 3)
Else
MyNo = "0" + Mid$(GetNo, i + 2, 2)
End If

If (Mid$(MyNo, 1, 3)) > 0 Then

RdNo = Mid$(MyNo, 1, 1)
My100 = MyArry1(RdNo)
RdNo = Mid$(MyNo, 3, 1)
My1 = MyArry3(RdNo)
RdNo = Mid$(MyNo, 2, 1)
My10 = MyArry2(RdNo)

If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر"
If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر"
If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة"

If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd

GetTxt = My100 + My1 + My10

If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then
GetTxt = My100 + My11
If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11
End If

If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then
GetTxt = My100 + My12
If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12
End If

If (i = 0) And (GetTxt <> "") Then
If ((Mid$(MyNo, 1, 3)) > 10) Then
Mybillion = GetTxt + " مليار"
Else
Mybillion = GetTxt + " مليارات"
If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار"
If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران"
End If
End If

If (i = 3) And (GetTxt <> "") Then

If ((Mid$(MyNo, 1, 3)) > 10) Then
MyMillion = GetTxt + " مليون"
Else
MyMillion = GetTxt + " ملايين"
If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون"
If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان"
End If
End If

If (i = 6) And (GetTxt <> "") Then
If ((Mid$(MyNo, 1, 3)) > 10) Then
MyThou = GetTxt + " ألف"
Else
MyThou = GetTxt + " آلاف"
If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف"
If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان"
End If
End If

If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt
If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt
End If

i = i + 3
Loop

If (Mybillion <> "") Then
If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
End If

If (MyMillion <> "") Then
If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
End If

If (MyThou <> "") Then
If (MyHun <> "") Then MyThou = MyThou + MyAnd
End If

If MyFraction <> "" Then
If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
Else
NoToTxt = ReMark + MyFraction + " " + MySubCur
End If
Else
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
End If

End Function

ثم قم ياستدعائة من حقل المبلغ المطلوب  بالكود التالي

Me.المبلغ_كتابه = NoToTxt(Me.المبلغ, "جنيه", "قرش")

Database1.accdb

up

الف مبروك اخي العزيز

السلام عليكم

استاذي العزيز @jjafferr الله يبارك فيك

انا عملت الملف زي الطريفة  الاولى لكن لم يضبط معي

تحياتي لك

Database1.accdb