Set PowerPoint Theme as default using VBA - vba

I can't find the syntax anywhere for setting a PowerPoint theme as the default theme using Excel VBA or PowerPoint (2010) VBA.
To clarify what I'm trying to do, the steps to do this mannually are: go to the design tab in PowerPoint, right click on the desired theme and select the "Set as Default" option. This process sets the default theme and slide master default.
The syntax below will set the theme (using Excel VBA) once but will not set the theme as the default. How do I set the theme as the new default?
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible=True
Set PPPres = PPApp.Presentations.Add
PPPres.ApplyTemplate ("Location")
Much thanks to David for the ideas below but, unfortunately they do not work for my intended application. I am trying to create a macro that will set the default theme on open so that I can distribute that file to my org and control the slide template we are all working off of. This macro found HERE is very close but I cannot find syntax that will lock in the applied template. Thoughts?
Sub AutoOpen()
Dim ThemePath As String
Dim ThemeFile As String
Dim FullPath As String
ActivePresentation.PageSetup.SlideSize = ppSlideSizeOnScreen16x9
ThemeFile = "TestTemplate.potx"
ThemePath = "File Path"
FullPath = ThemePath + ThemeFile
On Error Resume Next
ActivePresentation.ApplyTemplate (FullPath)
If Err <> 0 Then
MsgBox (ThemeFile & " was not found in " & ThemePath)
End If
End Sub

I know this is 4 years too late, but I don't think that this question was ever adequately answered. In your code above you should set the following string variables to:
ThemeFile = "blank.potx" '(it has to be "blank" or else it won't work)
ThemePath = "C:\Users\" vba.environ("username") & "\AppData\Roaming\Microsoft\Templates"
http://youpresent.co.uk/set-the-default-template-when-powerpoint-starts/

Related

MS Word VBA: Get document's attached template

(Using Windows 10 and MS Word 2016. Global templates are: Normal.dotx and Autoload.dotm. Attached template to some docs is: Reference.dotx)
Hello everyone,
I'm having problems in VBA getting the attached template of a document.
I have a global template that loads when I load MS Word, called Autoload.dotm. But, for some specific documents, they use an attached template, which is not the global template (Autload.dotm) or the regular template (Normal.dotx). This attached template is called Reference.dotx.
So I use ActiveDocument.AttachedTemplate. But this returns Autoload.dotm, not Reference.dotx. I need to find out if the attached template defined in Developer->Document Template->Templates tab->Document Template is Reference.dotx. (Don't think it makes a difference, but the "Automatically update document styles" checkbox is checked.) Does anyone know how I can find if a document uses Reference.dotx? I don't need any of the global templates returned.
The code I'm using to try to get the attached template is simple:
If (ActiveDocument.AttachedTemplate = "Reference.dotx") Then
PrepareDocument_enabled = True
End If
Maybe this will help you? It will show the template used.
Sub Macro1()
Dim strPath As String
strPath = Dialogs(wdDialogToolsTemplates).Template
MsgBox strPath
End Sub
Otherwise, you can use this to change the template
Sub ChangeAttachedTemplate()
Dim oDoc As Document
Dim oTemplate As Template
Dim strTemplatePath As String
Set oDoc = ActiveDocument
If oDoc.Type = wdTypeTemplate Then Exit Sub
Set oTemplate = oDoc.AttachedTemplate
Debug.Print oTemplate.FullName
' Path is probably: C:\Users\USERNAME\AppData\Roaming\Microsoft\Templates\
If InStr(UCase(oTemplate.FullName), UCase("Path of the template")) > 0 Then
oDoc.AttachedTemplate = "PATH TO TEMPLATE" & "TEMPLATE NAME.dotm"
End If
End Sub

Open Visio Drawing using a Macro in Access 2010

I have a button on a form in my database that i would like to open a user guide on click. The user guide I have put to gether is in visio but i can't seem to find a way to open it using the macro builder. Is this something i would need to do using VBA? If so any suggestions on how the code should look?
I think something like the following may work, I have manipulated this to fit visio though, so hopefully it works.
Dim FName As String
Dim VisioApp As Object
On Error Resume Next
Set VisioApp = GetObject(, "Visio.Application")
If VisioApp Is Nothing Then
Set VisioApp = CreateObject("Visio.Application")
If VisioApp Is Nothing Then
MsgBox "Can't connect to Visio"
Exit Sub
End If
End If
On Error GoTo 0
FName = "C:\Path\FileName.vsd"
VisioApp.documents.Open FName '
VisioApp.Visible = True
You may need to go in to the VB editor, click Tools > References and then mark Microsoft Visio library as checked.

Save Excel Sheet text only to text file VBA

I am trying to copy the values of one column in a sheet to a text file. The code I currently have causes runtime error 434.
Sheets("Output to fcf.1").Columns("A").SaveToText "P:\4_Calcs\02. Flag Mapping\test_.txt"
If I try and save the whole sheet
Sheets("Output to fcf.2").SaveToText "P:\Clear Project Drive\CLE10276 AWS SMP Model Assessmnts\4_Calcs\02. Flag Mapping\test2_.txt"
I get the entire sheet converted into text rather than just the text in the sheet. Is there a simple way to do this?
Thanks in advance!
Not sure which Excel version you have but I don't see a method for SaveToText.
But this procedure should work, or at least get you started...
Sub SaveColumn(sheetName As String, columnName As String, fileName As String)
Dim cell
Dim fso
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(fileName, True)
For Each cell In Sheets(sheetName).Columns(columnName).Cells
If cell.Value <> "" Then
file.WriteLine cell.Value
End If
Next
file.Close
Set file = Nothing
Set fso = Nothing
End Sub
To call it...
SaveColumn "Output to fcf.1", "A", "P:\4_Calcs\02. Flag Mapping\test_.txt"
This is designed to be used as a macro.
Step by step guide:
1) From excel, hit Alt+F11 on your keyboard.
2) From the menu bar, click Insert, then Module
3) Copy and paste the code provided below into the new module that opens.
NOTE: DocPath = "C:\docs\data.txt" should be wherever you want the output file saved, including the file's actual name. Remember, the folder you want the output file to be located in should ALREADY exist. This does not create the folder if it can't be found.
4) From the menu bar, click Tools, then References. Make sure both "Microsoft Office 14.0 Object Library" as well as "Microsoft Word 14.0 Object Library" are checked, and hit okay (See screenshot for details)
5) Save the document as an .xlsm file (This file type supports Macros)
6) Close the VBA editor. Back in Excel, on the ribbon click View and then Macros. Your new macro should be in the list as ExportToTXT
7) Select it and hit run.
Sub ExportToTXT()
Dim DocPath As String
Dim MsgBoxCompleted
Columns("A").Select
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Selection.Copy
DocPath = "C:\docs\data.txt"
'Create and save txt file
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
Application.CutCopyMode = False
AppWord.Quit (wdDoNotSaveChanges)
Set AppWord = Nothing
MsgBoxCompleted = MsgBox("Process complete.", vbOKOnly, "Process complete")
End Sub
Good luck, and if you have any questions, don't hesitate to ask.
NOTE: These directions might seem overly simplified for your skill level, but I wrote the answer like this to potentially help others in the future.
EDIT
Change
DocPath = "C:\docs\data.txt"
to
DocPath = "C:\docs\data.fcf"
And change
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
to
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath
The output file will be .fcf format. Whether or not it will open properly is something I'm not sure of. You'd have to test in the program you're using.

Occasional VBA Method 'Activate' of object 'ChartData' failed

Before I begin, here is some history:
Created VBA in Excel to open and read three (3) Excel files (includes itself) and input data into charts/tables/graphs into a PowerPoint presentation. This version runs beautifully. VBA kicked off by a User Form
Modified code to fit a requirement passed down to me. This one causes the error of VBA Method 'Activate' of object 'ChartData' when loading a graph in one particular slide. This data is transferred from the sheet that kicks off the VBA.
I was unable to recreate this error steadily until I started saving the Excel file that kicks off the script when it asked. Now I can.
NO VBA resides in the powerpoint presentation.
Users testing this experience the error first time around. I do not. However, I do in the further iterations I do after saving the Excel book after either a successful or unsuccessful run.
Screen behaviors I've noticed when error occurs:
Only happens after I save the Excel that kicked off the procedure and I test the procedure again when trying to re-create error.
PowerPoint presentation becomes the 'activated' application while VBA runs in background
Happens on the same slide and chart (yes, using object labels in PowerPoint).
When error occurs and I break code, I can NOT close PowerPoint or Excel using the File menu. I HAVE to use the 'Red X' in the upper right hand corner to close. The ribbons and tabs are also unusable (do not react to a clicking event). Microsoft does ask the Save option.
What I've tried:
Walking through code and explicitly closing objects after they've been opened and are not required.
Varying the placement of the ScreenUpdating, etc. Application processes
Here is the function where it trips. It trips up at trpChartData.Activate for a particular graph (which is shapeName):
Function insGraphInfo(ByVal numOfSlide As Integer, ByVal shapeName As String, ByVal cellToMod As String, ByVal valToIns As Variant) As Variant
'Inserts data into a CHART TYPE graph
On Error GoTo ERR_INS_GRAPH
Dim trpChart As PowerPoint.Chart
Dim trpChartData As ChartData
Dim trpWkBk As Excel.Workbook
Dim trpChartSheet As Excel.Worksheet
Dim errString As String
Set oPPTSlide = oPPTFile.Slides(numOfSlide)
With oPPTSlide
.Select
End With
Set oPPTShape = oPPTFile.Slides(numOfSlide).Shapes(shapeName)
Set trpChart = oPPTShape.Chart
Set trpChartData = trpChart.ChartData
Debug.Print "Activating: " & shapeName & " in slide number: " & numOfSlide
errString = "Activating: " & shapeName & " in slide number: " & numOfSlide
trpChartData.Activate
Debug.Print shapeName & " activated."
errString = shapeName & " activated."
errString = "Setting Workbook and Worksheet Objects"
Set trpWkBk = trpChartData.Workbook
Set trpChartSheet = trpWkBk.Worksheets(1)
errString = "Inserting Value into appropriate cell)"
With trpChartSheet
.Range(cellToMod).Value = valToIns
End With
insGraphInfo = valToIns
errString = "Refreshing Chart."
With oPPTShape 'Refreshes
.Chart.ChartData.Activate
.Chart.ChartData.Workbook.Close
.Chart.Refresh
End With
Set trpWkBk = Nothing
Set oPPTSlide = Nothing
Set oPPTShape = Nothing
Exit Function
ERR_INS_GRAPH:
MsgBox "An error occurred while: " & errString
Resume Next
End Function
Excel and PowerPoint are created by two different teams of developers.
PowerPoint.Chart is not the same as Excel.Chart
Yes, they look the same and you would think that you have the same level of access to their properties, but that is where you would be wrong. The PowerPoint version is very limited.
Anyway, as far I can tell, you went wrong when you declared
Dim trpChartData As ChartData
Instead of
Dim trpChartData As PowerPoint.ChartData
As Rachel pointed out,
trpChartData is declared without a library qualifier and thus defaults to Excel.ChartData
In addition to that you never cleared trpChartData with
Set trpChartData = Nothing
I also don't see where you .Quit the Excel application for the Chart.Workbook that must have been created. This could explain why there were versions of Excel open in the Task Manager afterwards. Try adding this...
Dim xlApp as Excel.Application
'
'
Set xlApp = .Chart.ChartData.Workbook.Application
'
'
xlApp.Quit
Set xlApp = Nothing

Setting Document Properties while saving individual sheets

I'm not familiar with VBA at all so this has me stumped, hoping someone can help.
I have a template on a sharepoint server that is working correctly. In order to save the xlsm file with the server document properties, I have a command button which runs the following:
Sub UpdateDB()
For Each Prop In ThisWorkbook.ContentTypeProperties
If Prop.Name = "Name" Then
Prop.Value = Range("B8").Value
End If
Next Prop
Filename = Range("B59").Value
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=52
End Sub
This is working well.
I now have another template which I want to do a similar thing but there are some complications:
I have several worksheets which I would like saved as individual files containing only the said worksheet.
The document properties for each file should different, based on a cell in each worksheet.
Now I have managed to setup point 1 and it's working OK using the following code:
Sub NewSub()
Worksheets("EMP1").Activate
Filename = Range("B1").Value
Dim wb as Workbook
Application.ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Filename:=Filename, FileFormat:=52
End With
End Sub
This is working well but if I try adding in code to set the Document Properties, it doesn't work, it won't carry them through to the new file. I have tried adding the code which sets the document properties after line 2 and I have tried adding it also after line 7; it doesn't throw an error but it doesn't set any document properties either. Any help on this would be much appreciated. Thanks.