{"id":653,"date":"2019-04-09T16:27:31","date_gmt":"2019-04-09T23:27:31","guid":{"rendered":"https:\/\/doubleecpu.com\/?page_id=653"},"modified":"2022-06-12T23:24:59","modified_gmt":"2022-06-13T06:24:59","slug":"vba-access-export-to-power-point","status":"publish","type":"page","link":"https:\/\/doubleecpu.com\/index.php\/microsoft\/visual-basic-for-applications\/vba-access-export-to-power-point\/","title":{"rendered":"VBA Access Export to Power Point"},"content":{"rendered":"\n
Option Compare Database\nOption Explicit\n''***********************************************''\n' Name:\n' Date: Created Date\n' Author: Gilbert Medel\n' Current Version: 3.1.0\n' Called by:\n''***********************************************''\n' Notes:\n''***********************************************''\n' Global Variables\nPublic ppt_app As Object\nPublic ppt_Presentation As Object\nPublic ppt_Presentation_Name As Variant\nPublic ppt_Slide As Object\nPublic ppt_Shape As Object\nPublic Date_Time As Date\n''***********************************************''\n' Private Variables\nPrivate Parent_Reference As Object\nPrivate Data_Recset As Object\nPrivate Self_Reference As Object\nPrivate Const Object_Type As String = \"Export_To_PPT\" 'Identifies Class object Type\nPrivate Notes_ As Variant\nPrivate Obj_FileSystem As Object\n''***********************************************''\n' Public properties\nPublic Property Get Name() As String\nName = Object_Type\nEnd Property\nPublic Property Get Application() As Object\nSet Application = Parent_Reference.Application\nEnd Property\nPublic Property Get Self_Ref() As Object\nSet Self_Ref = Self_Reference\nEnd Property\nPublic Property Set Self_Ref(Reference_Object As Object)\nSet Self_Reference = Reference_Object\nEnd Property\nPublic Property Get Parent() As Object\nSet Parent = Parent_Reference\nEnd Property\nPublic Property Set Parent(Reference_Object As Object)\nSet Parent_Reference = Reference_Object\nEnd Property\n''***********************************************''\n' Public Functions that return values\nPublic Function Export_Planning_Slides(Parent_Ref As Object) As Boolean\nDim IPR_Object As Object\n'Prepare Data For Export\n'Determine if Template is Available\nExport_Planning_Slides = False\nDate_Time = TID_G.Factory.TID_Current_Date(TID_File_Name_by_Year)\nSplash 1, \"Export Starting\", 0\nSet Parent_Reference = Parent_Ref.Module.Parent\nIf Parent_Reference Is Nothing Then\nSplash 6, \"Export Error\", 1\nElse\n'Create PowerPoint If Possible\nPowerPoint_Available \"power point template\"\n'Use child class to fill out Slide Data\nSet IPR_Object = TID_G.Factory.Create_Export_Object(\"Export_IPR_Class\")\nIPR_Object.Export_Slides Self_Reference\nEnd If\n'Completed release objects\nSplash 6, \"Clearing Export Variables\"\nZeroize\nEnd Function\n''***********************************************''\n' Public Sub Routines\n''***********************************************''\n' Private Functions\n''***********************************************''\n' Private Subs Routines\nPrivate Function PowerPoint_Available(Office_Description As Variant) As Object\n'Get the recordset row with attachment field\n'Sets The Available Power Point to transfer data to file based on template or New Blank\nSplash 2, \"Creating PowerPoint\"\nSet Data_Recset = Parent_Reference.Application.DBEngine.Workspaces(0).Databases(0).OpenRecordset(\"SELECT * FROM TID_Office_Files WHERE (Office_Description = \" & Chr(39) & Office_Description & Chr(39) & \")\", dbOpenSnapshot)\nIf Data_Recset.RecordCount = 1 Then\n'Open template and set reference to it\nSplash 3, \"Using PowerPoint template\"\nSave_With_Template\nElse\n'Open Without Template\nSplash 3, \"could not use PowerPoint template\"\nSave_Without_Template\nEnd If\nAdd_Distro_D\nSplash 6, \"Finished PowerPoint Export\"\nData_Recset.Close\nSet Data_Recset = Nothing\nEnd Function\nPublic Function Save_With_Template() As Long\nDim Complex_Recset As Object\nDim File_From_Table As Object\n\nIf Data_Recset.Fields(\"Network_PKEY\") = 1003 Then\nppt_Presentation_Name = Format(TID_G.TID_Now, \"YYYYmmdd\") & \"_IPR_Export.ppt\"\nSplash 2, \"Checking If File Exists\"\nCheck_Export_Status False\n'Get the recordset for the Attachments field\nSet Complex_Recset = Data_Recset.Fields(\"Office_File\").Value\n'Save all attachments in the field\nSplash 3, \"Saving File\"\nSet File_From_Table = Complex_Recset.Fields(\"FileData\")\nFile_From_Table.SaveToFile (Parent.Application.CurrentProject.Path & \"\\\" & ppt_Presentation_Name)\nSplash 3, \"File Saved\"\nSet ppt_app = TID_G.Factory.Create_Office_Object(\"PowerPoint.Application\")\nppt_app.Presentations.Open FileName:=(Parent.Application.CurrentProject.Path & \"\\\" & ppt_Presentation_Name)\nSplash 3, \"Opening Export PPT\"\nSet ppt_Presentation = ppt_app.Presentations(ppt_Presentation_Name)\nppt_Presentation.windows.Item(1).viewType = 9 'ppViewNormal\nEnd If\nSet File_From_Table = Nothing\nSet Complex_Recset = Nothing\nEnd Function\nPublic Function Save_Without_Template() As Long\nDim FileDialog_SaveAs As Object\nppt_Presentation_Name = Format(TID_G.TID_Now, \"YYYYmmdd\") & \"_IPR_Export.ppt\"\nTID_SplashScreenControl.StatusMessage 2, \"Checking If File Exists\", 0, Date_Time\nCheck_Export_Status False\nTID_SplashScreenControl.StatusMessage 3, \"Saving File\", 0, Date_Time\nSet ppt_app = TID_G.Factory.Create_Office_Object(\"PowerPoint.Application\")\nSet FileDialog_SaveAs = ppt_app.FileDialog(msoFileDialogSaveAs)\nppt_app.Presentations.Add True\nSet ppt_Presentation = ppt_app.Presentations(1)\nWith FileDialog_SaveAs\n.Title = \"Please Select Where to Save File\"\n.InitialFileName = Parent.Application.CurrentProject.Path & \"\\\" & Left(ppt_Presentation_Name, Len(ppt_Presentation_Name) - 4)\n.Show\nIf .SelectedItems.Count = 1 Then\nSave_Without_Template = True\n.Execute\nTID_SplashScreenControl.StatusMessage 3, \"File Saved\", 0, Date_Time\nEnd If\nEnd With\nSet FileDialog_SaveAs = Nothing\nEnd Function\nPrivate Sub Check_Export_Status(Recursion As Boolean)\n'Runs_Recursively until File Name does not match\nDim File_Test As Object\nSet File_Test = TID_G.Factory.Create_SYNC_Object(\"SYNC_Connection_Class\")\nIf File_Test.Check_Export_Exists(Self_Reference, ppt_Presentation_Name) Then\nIf Recursion Then\nppt_Presentation_Name = Left(ppt_Presentation_Name, Len(ppt_Presentation_Name) - 4) + \"1\" + \".ppt\"\nCheck_Export_Status True\nElse\nSelect Case MsgBox(\"File Exists do you want to delete and Replace?\", vbYesNo, \"Export IPR\")\nCase vbYes\n'Delete Existing File\nSet File_Test = Nothing\nSet File_Test = TID_G.Factory.Create_Office_Object(\"Scripting.FileSystemObject\")\nFile_Test.DeleteFile Parent.Application.CurrentProject.Path & \"\\\" & ppt_Presentation_Name\nCase Else\nppt_Presentation_Name = Left(ppt_Presentation_Name, Len(ppt_Presentation_Name) - 4) + \"1\" + \".ppt\"\nCheck_Export_Status True\nEnd Select\nEnd If\nEnd If\nEnd Sub\nPrivate Sub Add_Distro_D()\nDim ppt_Shape As Object\n'Selects the first slide and applys slide layout\nIf ppt_Presentation.Slides.Count >= 1 Then\nSet ppt_Slide = ppt_Presentation.Slides(1)\nppt_Slide.customLayout = ppt_Presentation.SlideMaster.CustomLayouts(2)\nElse\nSet ppt_Slide = ppt_Presentation.Slides.AddSlide(1, ppt_Presentation.SlideMaster.CustomLayouts(2))\nEnd If\nSet ppt_Shape = ppt_Presentation.SlideMaster.Shapes.AddTextBox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=503.625, Width:=654, Height:=29.08126)\nppt_Shape.TextEffect.Text = DistributionStatementD\nppt_Shape.TextEffect.FontSize = 8\nppt_Shape.TextEffect.FontName = \"Arial\"\nEnd Sub\nPublic Sub Zeroize()\nOn Error GoTo Err_Zeroize:\nDate_Time = 0\nppt_Presentation_Name = Null\nSet ppt_app = Nothing\nSet ppt_Presentation = Nothing\nSet ppt_Slide = Nothing\nSet ppt_Shape = Nothing\nSet Obj_FileSystem = Nothing\nSet Parent_Reference = Nothing\nSet Data_Recset = Nothing\nSet Self_Reference = Nothing\nExit Sub\nErr_Zeroize:\nMsgBox \"unable to Zeroize\", vbCritical, \"PR Data Zeroize\"\nTID_G.Log_Err Object_Type, \"Zeroize\", Self_Reference, \"Unable To Zeroize\"\nEnd Sub\nPrivate Sub Class_Initialize()\nZeroize\nEnd Sub\nPrivate Sub Class_Terminate()\nZeroize\nEnd Sub\n''***********************************************''\n'End Code\n<\/pre>\n\n\n\n
<\/p>\n","protected":false},"excerpt":{"rendered":"
Option Compare Database Option Explicit ”***********************************************” ‘ Name: ‘ Date: Created Date ‘ Author: Gilbert Medel ‘ Current Version: 3.1.0 ‘ Called by: ”***********************************************” ‘ Notes: ”***********************************************” ‘ Global Variables Public ppt_app As Object Public ppt_Presentation As Object Public ppt_Presentation_Name As Variant Public ppt_Slide As Object Public ppt_Shape As Object Public Date_Time As Date ”***********************************************” … <\/p>\n
Read more “VBA Access Export to Power Point”<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"parent":591,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"footnotes":""},"class_list":["post-653","page","type-page","status-publish","hentry"],"featured_media_urls":[],"_links":{"self":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/653","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/comments?post=653"}],"version-history":[{"count":3,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/653\/revisions"}],"predecessor-version":[{"id":2669,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/653\/revisions\/2669"}],"up":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/591"}],"wp:attachment":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/media?parent=653"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}