اذهب الي المحتوي
أوفيسنا

( Qr Barcod الخطوط +انشاء تلقائي)+ لتهية مشروعك او نظامك تلقائية من المرفقات الى تثبيت + فك الضغط + اكسس 2025

hanan_ms

بواسطه hanan_ms
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

hanan_ms

hanan_ms

قام بنشر
قام بنشر

=============================================( صور + مرفق + فيديو )

Update: :biggrin2:🌹

بعد اذن استاذي @ابو جودي ❤️🌹☕🌹

بعد اذن الاستاذ @Moosak ❤️🌹☕

بعد اذن الاستاذ @Amr Ashraf ❤️🌹

بعد اذن الاستاذ @Foksh 🌹❤️☕

 

هل من توصية او اقتراح بالتعديل والاضافة :rol:

 

اداة بسيطة لحفظ مرفقات مشروعك او نظامك ويعمل فوري عند بداية التشغيل وعند فقط اي من الملفات اكثر من 16 نوع منها :

- خطوط 

-ادوات تنفيذية

-صور

-فيديو

-صوت

-نصوص وورد

-اكسل

-بور بوينت

-وتفصيلات اخرى 

- ملفات الضغط 

يعمل الكل من انشاء ملفات واستخراج من المرفقات الى الملفات والتثبيت وفك الضغط تلقائي 

ملاحظة الخطوط تثبت ولكن تغيرها فقط بوضع التصميم ثم الفتح الكود 

Dim s                  As Integer

For s = 1 To 1
DoCmd.OpenForm "xf", acDesign, , , , acHidden
Form_xf.xx.FontName = Me.x
Form_xf.x.FontName = Me.x
Next
DoCmd.Close acForm, "xf", acSaveYes

DoCmd.OpenForm "xf"

ما ينفع تغير نوع الخط بالكود 

Me.Text.FontName = "Font_X"

الا اذا تم نقلهم وتثبيتهم في ملف الخطوط بالويندوز

الحديث:

1- اضافة انشاء الباركود  ويثبت تلقائي بصيغة تنفيذية من غير تثبيته 

exe 

2- اضافة بسيطة لادراجة وتجربة كيو باركود

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

On Error GoTo Ops

If txtRec = DCount("[Id]", "[Add_Custorm_QR]") Then
Me.cmdLast.Enabled = False
Me.cmdNext.Enabled = False
Else
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If DCount("[Id]", "[Add_Custorm_QR]") > txtRec Then
Me.cmdPrevious.Enabled = True
Me.cmdFirst.Enabled = True
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If DCount("[Id]", "[Add_Custorm_QR]") = 0 Then
Me.cmdPrevious.Enabled = False
Me.cmdFirst.Enabled = False
Me.cmdLast.Enabled = False
Me.cmdNext.Enabled = False
Me.cmDelete.Enabled = False
Else
Me.cmDelete.Enabled = True
End If

If txtRec = 1 Then
Me.cmdPrevious.Enabled = False
Me.cmdFirst.Enabled = False
Else
Me.cmdPrevious.Enabled = True
Me.cmdFirst.Enabled = True
End If

Exit Sub

Ops:
MsgBox Err.Description & Err.Number
Exit Sub

-اعادة الترقيم التلقائي ببساط بكود 

DOA 

On Error GoTo Ops

Dim RS                      As DAO.Recordset
Dim dbs                     As DAO.Database
Dim strsq2                  As String
Dim sof                     As LongLong
Dim iprgrs                  As Integer

'=======================================================( Set Number 0
strsq2 = "Update Add_Custorm_QR Set nx = '" & 0 & "'"
CurrentDb.Execute strsq2
DoEvents

'=====================================================( set prograse
Me.ProgressBar3.max = DCount("[Id]", "[Add_Custorm_QR]")
Me.xc.Caption = "Counting... " & Me.ProgressBar3 & "/" & "100%"
        Me.ProgressBar3 = 1

'======================================================( 1 To End Count Record
Set dbs = CurrentDb

sof = 0
        Set RS = CurrentDb.OpenRecordset("Add_Custorm_QR")
Do While Not RS.EOF
sof = sof + 1
 RS.Edit
 RS![Nx] = RS![Nx] + sof
 On Error Resume Next
 RS.Update
 RS.MoveNext
 'Exit Do 'This will exit loop after first record
Loop
 Me.ProgressBar3 = 1

RS.Close
Set RS = Nothing
dbs.Close

    For iprgrs = 1 To DCount("[Id]", "[Add_Custorm_QR]")
        Me.xc.Caption = "Counting... " & iprgrs & "/" & "100%"
        On Error Resume Next
        Me.ProgressBar3 = iprgrs
        DoEvents
    Next

Me.lblCount.Caption = DCount("[Id]", "[Add_Custorm_QR]")
If IsNull(Me.idx) Or Me.idx Then
DoCmd.GoToRecord , , acFirst
Else
  DoCmd.SearchForRecord acDataForm, "Qr", acFirst, "[ID] = " & Me!idx
Me.idx = ""
End If

Exit Sub

Ops:
MsgBox Err.Description & Err.Number
Exit Sub

3- تعديل على الدالة 

 

======================================( تحديث سابق

1- اضافة 16 نوع من ملفات تثبت وتضاف عند الفتح وعند الفقد + ملفات التشغيلية + ملفات المضغوطة

ملاحظة:

-اذا كان .exe  غير الى .ex  بعد التنفيذ يغير الى exe. 

- اذا ملف فك الضغط

Zip يبدأ في حذف الملف ثم الفك التلقائي للملفات 

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

☕

=============================================( مرفق + فيديو )

 

Qr_With_AppRunAuto_V-1-7 Add Folder_with _File_ SyS_ Ms_Access.rar

Foksh

Foksh

قام بنشر
قام بنشر
5 ساعات مضت, hanan_ms said: 
On Error GoTo Ops

If txtRec = DCount("[Id]", "[Add_Custorm_QR]") Then
Me.cmdLast.Enabled = False
Me.cmdNext.Enabled = False
Else
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If DCount("[Id]", "[Add_Custorm_QR]") > txtRec Then
Me.cmdPrevious.Enabled = True
Me.cmdFirst.Enabled = True
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If DCount("[Id]", "[Add_Custorm_QR]") = 0 Then
Me.cmdPrevious.Enabled = False
Me.cmdFirst.Enabled = False
Me.cmdLast.Enabled = False
Me.cmdNext.Enabled = False
Me.cmDelete.Enabled = False
Else
Me.cmDelete.Enabled = True
End If

If txtRec = 1 Then
Me.cmdPrevious.Enabled = False
Me.cmdFirst.Enabled = False
Else
Me.cmdPrevious.Enabled = True
Me.cmdFirst.Enabled = True
End If

Exit Sub

Ops:
MsgBox Err.Description & Err.Number
Exit Sub

 

ما رأيك بهذا الإقتراح :smile: ، لتلافي استخدام DCount المتكرر .. 

On Error GoTo Ops

Dim recordCount As Long
recordCount = DCount("[Id]", "[Add_Custorm_QR]")

If recordCount = 0 Then
    Me.cmdPrevious.Enabled = False
    Me.cmdFirst.Enabled = False
    Me.cmdLast.Enabled = False
    Me.cmdNext.Enabled = False
    Me.cmDelete.Enabled = False
Else
    Me.cmDelete.Enabled = True
    Me.cmdPrevious.Enabled = (txtRec > 1)
    Me.cmdFirst.Enabled = (txtRec > 1)
    Me.cmdLast.Enabled = (txtRec < recordCount)
    Me.cmdNext.Enabled = (txtRec < recordCount)
End If

Exit Sub

Ops:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
Exit Sub

استخدامت المتغير txtRec لمقارنة المواضع بدل ما يتم استدعاء DCount المتكرر :yes:

  • Like 1
hanan_ms

hanan_ms

قام بنشر
  • الكاتب
قام بنشر
12 hours ago, Foksh said: 
On Error GoTo Ops

Dim recordCount As Long
recordCount = DCount("[Id]", "[Add_Custorm_QR]")

If recordCount = 0 Then
    Me.cmdPrevious.Enabled = False
    Me.cmdFirst.Enabled = False
    Me.cmdLast.Enabled = False
    Me.cmdNext.Enabled = False
    Me.cmDelete.Enabled = False
Else
    Me.cmDelete.Enabled = True
    Me.cmdPrevious.Enabled = (txtRec > 1)
    Me.cmdFirst.Enabled = (txtRec > 1)
    Me.cmdLast.Enabled = (txtRec < recordCount)
    Me.cmdNext.Enabled = (txtRec < recordCount)
End If

Exit Sub

Ops:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
Exit Sub

👍

12 hours ago, Foksh said:

ما رأيك بهذا الإقتراح :smile:

بتأكيد افضل ومختصر ☕🌹❤️  

شكرا

+ + +  بخلص ورفع التحديث 

ومنتظره رايك :yes:

 

hanan_ms

hanan_ms

قام بنشر
  • الكاتب
قام بنشر

=============================================( صور + مرفق + فيديو )

Update: :biggrin2:🌹

بعد اذن استاذي @ابو جودي ❤️🌹☕🌹

بعد اذن الاستاذ @Moosak ❤️🌹☕

بعد اذن الاستاذ @Amr Ashraf ❤️🌹

بعد اذن الاستاذ @Foksh 🌹❤️☕

 

هل من توصية او اقتراح بالتعديل والاضافة :rol:

 

1- تكامل الادخال البيانات بالجديد والحفظ الرجوع يمكن كده تلسمه للعميل

2- عند تحريك المؤشر تغير  الحقول مع ليبل تغيره الى زر مع الضغط

3-4-5 ....:rol:

(الكل من غير  [ دوال ] الا الغاء زر الاغلاق وتمكينة (لا يتمكن المستخدم من ترك الاضافة الجديده او التعديل (الا بالحفظ او الرجوع ) ☕

 على فكرة كود استاذ @Foksh :eek2::biggrin2:

جرب وغير تلاحظ الازرار لا تغير التمكين

لا يعمل عند التنقل ما سويت سحر 😂

 

فرجعة على الكود سابق فشغال مع استكمال اذا كان جديد

كود: 

On Error GoTo Ops

Dim recordCount As String '========================== ( IF No Count Sum Or Change Only Number String 255 k
recordCount = Nz(DCount("[Id]", "[Add_Custorm_QR]"), 0) '=========================( Not Number No Long Smoll and Long Long , Look for read db Link Acountes 1 To 20 Full Size , This Text


If txtRec = recordCount Then
Me.cmdLast.Enabled = False
Me.cmdNext.Enabled = False
Else
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If recordCount > txtRec Then
Me.cmdPrevious.Enabled = True
Me.cmdFirst.Enabled = True
Me.cmdLast.Enabled = True
Me.cmdNext.Enabled = True
End If

If recordCount = 0 Then
    Me.cmdPrevious.Enabled = False
    Me.cmdFirst.Enabled = False
    Me.cmdLast.Enabled = False
    Me.cmdNext.Enabled = False
    Me.cmDelete.Enabled = False
    Me.Save.Enabled = False
    Me.UndoR.Enabled = False
    Me.n.Enabled = False
    Me.x.Enabled = False
Else
    Me.cmDelete.Enabled = True
    Me.n.Enabled = True
    Me.x.Enabled = True
End If

If txtRec = 1 Then
    Me.cmdPrevious.Enabled = False
    Me.cmdFirst.Enabled = False
Else
    Me.cmdPrevious.Enabled = True
    Me.cmdFirst.Enabled = True
End If

If Me.Editor_date = -1 Then
    Me.PID.Enabled = True
    Me.PID.Locked = False
    Me.PName.Enabled = True
    Me.PName.Locked = False
    Me.PPhone.Enabled = True
    Me.PPhone.Locked = False
    Else
    Me.PID.Enabled = False
    Me.PID.Locked = True
    Me.PName.Enabled = False
    Me.PName.Locked = True
    Me.PPhone.Enabled = False
    Me.PPhone.Locked = True
End If

Exit Sub

Ops:
'=====================================( For New Record
If IsNull(Me.txtRec) Or Me.txtRec = "" Then
Exit Sub
Else
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")", vbExclamation, " :: Error Chack Devloper :: "
Exit Sub
End If

 

Contrl_Record_With_Qr__AppRunAuto_V-1-8 Add Folder_with _File_ SyS_ Ms_Access.rar

  • Like 1

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept