اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

( 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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

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

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

Important Information

  I accept