تحميل عدة صور وعرضها تباعا كل 30 ثانية

[ًعبد من عباد الله]

سلام الله على الجميع

بالمرفق عمل والمطلوب مذكور بداخله وشكرا لتعاونكم

Pictures1.rar

[ًعبد من عباد الله]

أخى الكريم

بداية شاكر جدا لاهتمامك بالرد وما أرشدتنى إليه ولكنه ليس المطلوب انا لا أريد ان تتحرك الصورة وكانها شريط متحرك كما في الموضوع الذى أحلتنى إليه ولكن أريد أن تظل الصورة ساكنه بمكانها حتى إذا مر وقت 30 ثانية أختفت هذه الصورة المعروضة وظهورت الصورة التالية وهكذا أتمنى أن المقصود يكون أكثر وضوحا الآن وشكرا مقدما لكل من يدلى بدلوه بالمشاركة المثمرة

تم تعديل يوليو 27, 2017 بواسطه وائل أبو عبد الرحمن

[ًعبد من عباد الله]

أخى الكريم بارك الله فيك

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

[ًعبد من عباد الله]

للرفع

[ًعبد من عباد الله]

الأخوة الكرام أنا لست مبرمج

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

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

تم تعديل يوليو 28, 2017 بواسطه وائل أبو عبد الرحمن

[Shivan Rekany]

اتفضل

انا عملت لك مشاهدة تلقائي خلال 3 ثواني تقدر تتغيره

 

Pictures1.rar

[ًعبد من عباد الله]

الأستاذ Shivan Rekany

شكرا لأهتمامك بالرد وحسن تجاوبك بالمشاركة الفاعلة 

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

وإذا أتسع لى صدرك وعلمك أريد كود لإضافة مجموعة صور دفعة واحد وليس صورة صورة وأكرر شكرى لحضرتك

[ًعبد من عباد الله]

الأستاذ Shivan Rekany

قد حاولت التعديل منذ الأمس ولم اوفق فضلا منك وتكرما مشكورا غير مأمور أنتظر من حضرتك بقية التعديل لإنهاء هذه النقطة مع كامل التقدير لمجهودكم.

تم تعديل يوليو 30, 2017 بواسطه وائل أبو عبد الرحمن

[Shivan Rekany]

17 ساعات مضت, وائل أبو عبد الرحمن said:

الأستاذ Shivan Rekany

شكرا لأهتمامك بالرد وحسن تجاوبك بالمشاركة الفاعلة 

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

وإذا أتسع لى صدرك وعلمك أريد كود لإضافة مجموعة صور دفعة واحد وليس صورة صورة وأكرر شكرى لحضرتك

اتفضل اخي
هذه وحدة نمطية و اكواد لاحتياج طلبك

Option Compare Database

'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim x As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
        .ulFlags = .ulFlags Or &H40
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If x Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

اكواد في نموذج

Option Compare Database
Dim Sec As Integer
Private Sub AddPictures_Click()
On Error Resume Next
Dim x As FileDialog
Set x = Application.FileDialog(msoFileDialogFilePicker)
x.AllowMultiSelect = True
If x.Show = -1 Then
For i = 1 To x.SelectedItems.Count
Me.PicFile = x.SelectedItems(i)
DoCmd.GoToRecord , , acNext
Next i
Me.imgPicture.Requery
End If

End Sub
Private Sub AutoChange_Click()
    Me.StopAndResume.Visible = True
    Me.StopAndResume.Caption = "Stop"
    Me.TimerInterval = 1000
    DoCmd.GoToRecord , , acFirst
End Sub
Private Sub Form_Timer()
    Sec = Sec + 1
If Sec >= 3 And Me.CurrentRecord <> Me.RecordsetClone.RecordCount Then
    DoCmd.GoToRecord , , acNext
    Sec = 0
    ElseIf Sec >= 3 And Me.CurrentRecord = Me.RecordsetClone.RecordCount Then
    MsgBox "æÕáäÇ Çáì ÇÎÑ ÕæÑÉ .. ÓíÊã ÇÛáÇÞ ÇáäãæÐÌ"
    DoCmd.Close acForm, Me.Name
End If
End Sub

Private Sub StopAndResume_Click()
    If Me.StopAndResume.Caption = "Stop" Then
            Me.TimerInterval = 0
            Me.StopAndResume.Caption = "Resume"
            Exit Sub
        ElseIf Me.StopAndResume.Caption = "Resume" Then
            Me.TimerInterval = 1000
            Me.StopAndResume.Caption = "Stop"
            Exit Sub
    End If
End Sub

وهذه ملفك بعد تعديل

 

اختیار اکثر من صورة و تشغيل تلقائي.rar

[ًعبد من عباد الله]

أستاذى الكريم

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

[Shivan Rekany]

2 دقائق مضت, وائل أبو عبد الرحمن said:

أستاذى الكريم

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

 

pic.rar

[ًعبد من عباد الله]

الأخ والأستاذ شفان ريكاني

شاكر لك حسن متابعتك وجميل صنعك فقد تحقق المطلوب الأول بالصورة المطلوبة وهى عمل مفتاح الاستعراض المستمر كل مدة محددة وجميل إضافة مفتاح التوقف وبالنسبة للمطلوب الثانى (إن لم أثقل عليك) بقيت له تكة بسيطة كما نقول بالمصرى وهى ان الوحدة النمطية "الموجودة لدى من قبل" نعم تقوم بجلب عدة صور دفعة واحدة ولكنها تقوم أيضا بجلب او أضافة المسار العام للصور على الحاسب للصورة وهذا ما لا اريده بل المطلوب ان تقوم بجلب وتضيف عدة صور دفعة واحدة ولكن حسب مسار الصورة في ملف fileStores فقط والمرفق بمسار قاعدة البيانات كما هو موضح بالصورة المرفقة ولكم منا جزيل الشكر 

تم تعديل يوليو 30, 2017 بواسطه وائل أبو عبد الرحمن

[ًعبد من عباد الله]

الأخ والأستاذ Shivan Rekany

 هل مازال في جرابكم ما يدعو للأنتظار أم أن الأمر قد أنتهى على ذلك أتمنى أنى لم أثقل عليكم

[Shivan Rekany]

في ٣٠‏/٧‏/٢٠١٧ at 19:05, وائل أبو عبد الرحمن said:

شاكر لك حسن متابعتك وجميل صنعك فقد تحقق المطلوب الأول بالصورة المطلوبة وهى عمل مفتاح الاستعراض المستمر كل مدة محددة وجميل إضافة مفتاح التوقف وبالنسبة للمطلوب الثانى (إن لم أثقل عليك) بقيت له تكة بسيطة كما نقول بالمصرى وهى ان الوحدة النمطية "الموجودة لدى من قبل" نعم تقوم بجلب عدة صور دفعة واحدة ولكنها تقوم أيضا بجلب او أضافة المسار العام للصور على الحاسب للصورة وهذا ما لا اريده بل المطلوب ان تقوم بجلب وتضيف عدة صور دفعة واحدة ولكن حسب مسار الصورة في ملف fileStores فقط والمرفق بمسار قاعدة البيانات كما هو موضح بالصورة المرفقة ولكم منا جزيل الشكر 

 

اتفضل اخي

احذف كل الاكواد السابقة

واليك هذه الاواد اللازمة للنموذج

Option Compare Database
Dim Sec As Integer
Private Sub AddPictures_Click()
On Error Resume Next
Dim x As FileDialog
Dim MyNam As String
Dim Mesar As String
Set x = Application.FileDialog(msoFileDialogFilePicker)
x.AllowMultiSelect = True
If x.Show = -1 Then
For i = 1 To x.SelectedItems.Count
    MyNam = Mid$(Trim(x.SelectedItems(i)), InStrRev(Trim(x.SelectedItems(i)), "\") + 1)
        FileCopy Trim(x.SelectedItems(i)), CurrentProject.Path + "\fileStores\" & ("" & MyNam & "")
    Mesar = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "")
 Me.PicFile = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "")
  Me.imgPicture.Picture = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "")
DoCmd.GoToRecord , , acNext
Next i
Me.imgPicture.Requery
End If
 Set x = Nothing

End Sub
Private Sub AutoChange_Click()
    Me.StopAndResume.Visible = True
    Me.StopAndResume.Caption = "Stop"
    Me.TimerInterval = 1000
    DoCmd.GoToRecord , , acFirst
End Sub
Private Sub Form_Timer()
    Sec = Sec + 1
If Sec >= 3 And Me.CurrentRecord <> Me.RecordsetClone.RecordCount Then
    DoCmd.GoToRecord , , acNext
    Sec = 0
    ElseIf Sec >= 3 And Me.CurrentRecord = Me.RecordsetClone.RecordCount Then
    MsgBox "æÕáäÇ Çáì ÇÎÑ ÕæÑÉ .. ÓíÊã ÇÛáÇÞ ÇáäãæÐÌ"
    DoCmd.Close acForm, Me.Name
End If
End Sub

Private Sub StopAndResume_Click()
    If Me.StopAndResume.Caption = "Stop" Then
            Me.TimerInterval = 0
            Me.StopAndResume.Caption = "Resume"
            Exit Sub
        ElseIf Me.StopAndResume.Caption = "Resume" Then
            Me.TimerInterval = 1000
            Me.StopAndResume.Caption = "Stop"
            Exit Sub
    End If
End Sub

واليك ملفك بعد تعديل

 

pic.rar

[ًعبد من عباد الله]

أخى شفان ريكاني ما شاء الله إبداع متواصل وكرم بالغ ومتابعة مشكورة بارك الله فيك

أسمح لى فقط أستاذى الفاضل أن ألفت نظركم الكريم كما بالصورة المرفقة إلى أن إضافة الصور مازالت تتم بمسارها العام بداء من الدريفر حتى موضع حفظ الصور والمطلوب فضلا هو أن يكون المسار من داخل المجلد FileStores فقط

والعلة والحكمة فى ذلك ان قاعدة البيانات هذه إذا تم نقلها لأى جهاز تبقى الصور موجودة وظاهرة بالمستعرض دون الحاجة لإعادة البحث عنها أو إعادة إضافتها. 

وأسمح لى بالمزيد من كرمك وسعة صدرك حتى لا اضطر لإتعابك معى مرة أخرى ويكتمل الأمر

أريد من حضرتك مفتاحين مفتاح لحذف الصورة الحالية فقط بشرط حذف سجلها من الجدول t_ViewPictures ومن الملف FileStores مرة واحدة.

ومفتاح أخر لحذف جميع الصور الموجودة بالجدول والملف أيضا عند الحاجة لذلك.

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

تم تعديل يوليو 31, 2017 بواسطه وائل أبو عبد الرحمن

[Shivan Rekany]

15 ساعات مضت, وائل أبو عبد الرحمن said:

أريد من حضرتك مفتاحين مفتاح لحذف الصورة الحالية فقط بشرط حذف سجلها من الجدول t_ViewPictures ومن الملف FileStores مرة واحدة.

ومفتاح أخر لحذف جميع الصور الموجودة بالجدول والملف أيضا عند الحاجة لذلك.

اتفضل اليك ما طلبت
لكن ارجوا ان لا نتعدى قوانين  المنتدى .. لكل موضوع سؤال جديد بعد البحث عن ما يريد

هذا هو الكود لحذف الصور مع السجل

Private Sub Command21_Click()
On Error Resume Next
    Dim MyPict As String
        DoCmd.SetWarnings False
            MyPict = CurrentProject.Path & Me.PicFile
        Kill (MyPict)
            DoCmd.RunCommand acCmdSelectRecord
            DoCmd.RunCommand acCmdDeleteRecord
            Me.Requery
        DoCmd.SetWarnings True
    MsgBox "تم الحذف"
End Sub

وهذه لحذف جميع الملفات من فولدر و حذف جميع السجلات

Private Sub Command22_Click()
On Error Resume Next
        Dim MyPict As String
            DoCmd.SetWarnings False
                MyPict = (CurrentProject.Path & "\" & "fileStores\*.*")
            Kill (MyPict)
                DoCmd.RunCommand acCmdSelectAllRecords
                DoCmd.RunCommand acCmdDeleteRecord
                Me.Requery
            DoCmd.SetWarnings True
    MsgBox "تم الحذف"
End Sub

ولطلبك هذا

15 ساعات مضت, وائل أبو عبد الرحمن said:

فضلا هو أن يكون المسار من داخل المجلد FileStores فقط

فقط تم حذف هذا

CurrentProject.Path +

من هذا

Me.PicFile = CurrentProject.Path + "\fileStores\" & ("" & mynam & "")

اي يبقى هذا

Me.PicFile =  "\fileStores\" & ("" & mynam & "")

واليك الملف بعد تعديل والاضافة

ولا تنسى اختار افضل جواب لكي من يفتح هذا الموضوع يعرف ويستفيد اكثر

تقبل تحياتي

 

pic.rar

[ًعبد من عباد الله]

الحمد لله الذى بتعمته تتم الصالحات

عاجز عن الشكر أخى الفاضل شفان ريكاني  

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

منذ ساعه, Shivan Rekany said:

لكن ارجوا ان لا نتعدى قوانين  المنتدى .. لكل موضوع سؤال جديد بعد البحث عن ما يريد

أنا لا اتعمد تعدى القانون ولكk تكامل الموضوع هو من فرض نفسه وأعتقد أن المواضيع المتكاملة كنز لمن يريد الانتفاع والتعلم في مكان واحد أفضل من التشتت بين كثرة الأسئلة وتعدد المواضيع والصفحات.

منذ ساعه, Shivan Rekany said:

ولا تنسى اختار افضل جواب لكي من يفتح هذا الموضوع يعرف ويستفيد اكثر

بالطبع ولكن وأين أجد ذلك فأنت لا تستحق أفضل إجابة فقط بل وأجملها كمان.

*** أستحى منك أخى الكريم ولكن لا حيلة لى إلا بتذكير حضرتك مشكورا بأخر طلب في اخر موضوع لى بالمنتدى وهو الموجود على الرابط التالى والخاص بالمستعرض المتنوع لعرض أنواع الملفات المختلفة عند أختيار احدها للعرض فمن ناحية ان هذا الموضوع هام جدا لى ومن ناحية أخرى سيكون فيه حل للنموذج الذى لا يفتح على التكبير.

شكر الله لك وتقبل منك وزادك مما تحسن وتريد وأسبغ عليك نعمه