أعرض سجلات الأكسس بواسطة الباوربوينت

[ابن مسقط]

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

هل تخيلت يوماً أنك تستطيع إستعراض سجلات قاعدة بيانات أكسس بواسطة برنامج الباوربوينت (وما أدراك ما البوربوينت )

قاعدة البيانات المرفقة تحوي بداخلها نموذجين وهما كالأتي :-

أولاً : النموذج: CreateFromAccessData

هذا النموذج يوجد عليه زر بأسم "PowerPoint Example " بمجرد النقر عليه ينشىء شريحة عرض بالباوربوينت جديدة ، يتم من خلالها عرض أحد سجلات قاعدة بيانات أكسس المرفقة مع المثال.

وشفرة الكود كالتالي :-

Sub cmdPowerPoint_Click()
Dim db As Database, rs As Recordset
Dim ppObj As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
On Error GoTo err_cmdOLEPowerPoint
' Open up a recordset on the Employees table.
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
' Open up an instance of Powerpoint.
Set ppObj = New PowerPoint.Application
Set ppPres = ppObj.Presentations.Add
' Setup the set of slides and populate them with data from the
' set of records.
With ppPres
While Not rs.EOF
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
.Shapes(1).TextFrame.TextRange.Text = "Hi!  Page " & rs.AbsolutePosition + 1
.SlideShowTransition.EntryEffect = ppEffectFade
With .Shapes(2).TextFrame.TextRange
.Text = CStr(rs.Fields("LastName").Value)
.Characters.Font.Color.RGB = RGB(255, 0, 255)
.Characters.Font.Shadow = True
End With
.Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
End With
rs.MoveNext
Wend
End With
' Run the show.
ppPres.SlideShowSettings.Run
Exit Sub
err_cmdOLEPowerPoint:
MsgBox Err.Number & " " & Err.Description
End Sub

ثانياً : النموذج: UseExistingPresentation هذا النموذج يقوم بعرض شرائح مشروع باوربوينت (Access2PowerPoint) الذي ستجدو ملفه من ضمن المرفقات على النموذج المذكور وذلك بمجرد النقر على الزر "Get Presentation" وشفرته كالتالي :-

Private Sub insertShow_Click()
On Error GoTo insertShow_Click_Error
' Open PowerPoint
Dim strPowerPointFile As String
Dim pptobj As PowerPoint.Application
Set pptobj = New PowerPoint.Application
pptobj.Visible = True
pptobj.WindowState = ppWindowMinimized
strPowerPointFile = CurrentProject.Path & "\Access2PowerPoint.ppt"
' Fill a collection with all Slide IDs.
With pptobj.Presentations.Open(strPowerPointFile)
Set mcolSlideIDs = New Collection
Dim ppSlide As PowerPoint.Slide
For Each ppSlide In .Slides
mcolSlideIDs.Add ppSlide.SlideID
Next
.Close
End With
' Close PowerPoint
pptobj.Quit
Set pptobj = Nothing
' Make object frame visible and enable "navigation" buttons.
pptFrame.Visible = True
frstSlide.Enabled = True
lastSlide.Enabled = True
nextSlide.Enabled = True
previousSlide.Enabled = True
' Specify OLE Class, Type, SourceDoc, SourceItem and other properties.
With pptFrame
.Class = "Microsoft Powerpoint Slide"
.OLETypeAllowed = acOLELinked
.SourceDoc = strPowerPointFile
End With
SetSlide 1
frstSlide.SetFocus
insertShow.Enabled = False
Exit Sub
insertShow_Click_Error:
MsgBox Err.Number & " " & Err.Description
Exit Sub
End Sub

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

ملاحظة: يجب أن يكون لديك Access 2000 أو الإصدار الأحدث وكذلك PowerPoint 2003

وستحتاج أن يكون لديك في قائمة المراجع References إلى مكتبات الربط التالية :

Microsoft PowerPoint 9.0 Object Library

Microsoft DAO 3.6 Object Library

وأخيرا أترك لك الفرصة لإنزاله وإستكشافه من الرابط التالي :

http://www.microsoft.com/downloads/details...&displaylang=en

------------

المصدر : http://msdn.microsoft.com/office/default.a...2Powerpoint.asp

بعد إنزال المثال سيتم تنصيبه داخل المجلد التالي :

C:\Office Samples\OfficeAccess2PowerPointSample

تم تعديل أكتوبر 11, 2005 بواسطه ابن مسقط

[rudwan]

جزاك الله خيرا أخي ابن مسقط و نفع الله بك

[ابن مسقط]

اللهم آمين

[HUSSIN]

شكراً لك أخي على هذا المثال المميز والمفيد ... وجعلة الله في موازين حسناتك

[ابن مسقط]

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

[ابو فتحى]

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

اخى الكريم 

المثال بجد رائع 

بس كيفية طريقة الربط بين الجدول و الشاشات PowerPoint

[ابو فتحى]

up