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

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


ابن مسقط

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

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

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

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

أولاً : النموذج: 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

تم تعديل بواسطه ابن مسقط
  • Thanks 1
رابط هذا التعليق
شارك

  • 12 years later...

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information