I am working on a vba macro that changes the fillpattern of various shapes depending on their name. I made some custom stencils (named "test") in another .vssx file and I try to use these stencils as fillpattern, without success.
When I check the vsoShp1.CellsU("FillPattern").FormulaU of my shape after I applied the custom stencil manualy, I get "USE("test")". But I do not understand how to select this FillPattern with vba code...
Here is a part of my code :
For Each vsoPage In vsoDoc.Pages
Set vsoDoc = vsoApp.Documents.Open(File.Path)
'Path of the .vssx file
strNewPath = local_path
Favoris = local_path & "\Favoris.vssx"
'Loading the .vssx file in a current open visio doc
Dim vsoDocNew As Visio.Document
Set vsoDocNew = vsoApp.Documents.OpenEx(Favoris, visOpenDocked + visAddStencil)
'Use the custom stencil for each shapes in the page
For Each vsoShp1 In vsoPage.Shapes
vsoShp1.CellsU("FillPattern").FormulaU = "test"
Next
Next
Related
First of all, I'm a newbie in VBA, and I'm trying to write some scripts for existing Visio document for automation purposes.
I see that my Visio file has objects with custom properties, and I want to play with those custom properties. (I know that seperate add-in is written for custom properties.)
Here I took a screenshot in my Visio file to show how Custom properties menu look like. This menu is accessed via custom add-in in Visio file.
Based on research, I wrote a simple macro as you see below.
For testing purposes I added shp.Name which works fine but shp.CellsU("Prop.Type").ResultStr("") fails.
I want to access and update custom properties of my shape as you see above.
My script file:
Sub Macro4()
Dim doc As Visio.Document
Dim pge As Visio.Page
Dim shp As Visio.Shape
For Each doc In Application.Documents
'Debug.Print "* " & doc.Name
For Each pge In doc.Pages
'Debug.Print "....s* " & pge.Name
If pge = "134-1" Then
For Each shp In pge.Shapes
Debug.Print "........* " & shp.Name
Debug.Print "........* " & shp.CellsU("Prop.Type").ResultStr("")
Next shp
End If
Next pge
Next doc
End Sub
If you help me with these, I would be appreciated!
At your picture we can see properties Labels (1st row), not their real Names (2nd row) !
Please check property Name!
I have a PowerPoint presentation in which I create charts in Excel and then link them into the PowerPoint. There are two ways to do this:
Paste Special > Paste Link > Microsoft Excel Chart Object
Paste > Keep Source Formatting and Link Data / Use Destination Theme and Link Data
I would late like to use VBA to change the source Excel file. To do this, consider the following code:
Private Sub PrintLinks()
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
Set pptPresentation = ActivePresentation
For Each pptSlide In pptPresentation.Slides
For Each pptShape In pptSlide.Shapes
If pptShape.Type = msoChart Or pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedChart Then
Debug.Print pptShape.LinkFormat.SourceFullName
pptShape.LinkFormat.SourceFullName = "PATH/TO/NEW/FILE"
pptShape.LinkFormat.Update
End If
Next
Next
End Sub
This will work for the Paste Link case, but not the Link Data case, in which case pptShape.Type = msoChart. My question is if there is a way to make it work with Link Data as well. Wtih Paste Link, the SourceFullName property will point to a specific chart object, like filename1.xlsx!Chart 1, and changing it to filename2.xlsx!Chart 1 will work as expected. In contrast, under the Link Data option the SourceFullName property only points to filename1.xlsx and I cannot figure out how to see what chart object within the file it is pointing to. Regardless, if I change SourceFullName to filename2.xlsx no error will be thrown, but as far as I can tell the pointer is still to filename1.xlsx, as the chart doesn't change.
I have a PowerPoint Presentation that gets filled with pictures by a VBA script attached to it. I want to automatically open the Presentation and run the macro. Here's what I have tried:
turning the script into an add-in as shown here: it ran when I clicked activated it, but never when I simply opened powerpoint.
downloaded a pre-built add in, and called my script sub auto_open(). This worked, but because it is a macro enabled file(?), but I have to open powerpoint up and enable the add in before opening the file, so it's not much more automatic than just running the macro
Running PowerPoint through MatLab. I used the following commands that I found here, which do open powerpoint, and the file I am interested in.
g = actxserver('PowerPoint.Application');
Presentation = invoke(g.Presentations,'Open','\\path\Automatic_NEdN_Template2.pptm')
a = invoke(Presentation.Application,'Run','Auto_Open',[])
With small test cases, it even seemed to work--I could call a vba function that read data from a file and it would return the data to matlab, but when I tried to call the one that makes pictures, it returned NaN and the PowerPoint was not filled.
Ideally, I'd like to double click on something, then have PowerPoint open, and run my script.
Here are some code snippets if they'll help:
Function read_in_data_from_txt_file(strFileName As String) As String()
Dim dataArray() As String
Dim i As Integer
'Const strFileName As String = "C:\H5_Samples\Plots\WeeklyPlots\zz_avgTemp.txt"
Open strFileName For Input As #1
' -------- read from txt file to dataArrayay -------- '
i = 0
Do Until EOF(1)
ReDim Preserve dataArray(i)
Line Input #1, dataArray(i)
i = i + 1
Loop
Close #1
read_in_data_from_txt_file = dataArray
End Function
And here is the code for the pictures:
Function Auto_Open() As String
Dim oSlide As Slide
Dim oPicture As Shape
Dim oText As Variant
Dim heightScaleFactor As Single
Dim widthScaleFactor As Single
Dim width As Single
heightScaleFactor = 2.1
widthScaleFactor = 2.1
width = 205
Height = 360
ActiveWindow.View.GotoSlide 2
Set oSlide = ActiveWindow.Presentation.Slides(2)
Set oPicture = oSlide.Shapes.AddPicture("C:\H5_Samples\Plots\WeeklyPlots\Nominal DS Real spectra.png", _
msoFalse, msoTrue, 1, 150, Height, width)
Set oPicture = oSlide.Shapes.AddPicture("C:\H5_Samples\Plots\WeeklyPlots\Nominal DS Imaginary spectra.png", _
msoFalse, msoTrue, 350, 150, Height, width)
'Full Resolution
ActiveWindow.View.GotoSlide 3
Set oSlide = ActiveWindow.Presentation.Slides(3)
Set oPicture = oSlide.Shapes.AddPicture("C:\H5_Samples\Plots\WeeklyPlots\Full Resolution DS Real spectra.png", _
msoFalse, msoTrue, 1, 150, Height, width)
Set oPicture = oSlide.Shapes.AddPicture("C:\H5_Samples\Plots\WeeklyPlots\Full Resolution DS Imaginary spectra.png", _
msoFalse, msoTrue, 350, 150, Height, width)
End Function
Two ways to do this come to mind:
An Add-in that has an application-level event handler. Then, you could leverage the application class PresentationOpen event, compare the filename against the known file which you want to operate on, and then run the macro only when the right file has been opened. See this MSDN link for some information about creating an application-level event handler class.
Use the Ribbon XML framework to call a procedure from the ribbon's OnLoad event.
The second method would be essentially self-contained whereas the previous method would require at least one additional Add-in file to control the process.
The second method would use VBA that looks something like:
Option Explicit
Public Rib As IRibbonUI
'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
Set Rib = ribbon
Call Auto_Open() '### I would recommend changing your procedure name just to avoid confusion...
End Sub
Sub Auto_Open()
'### This is your procedure/macro that you want to run
' etc
' etc
End Sub
And you would need the ribbon XML (use the CustomUI editor to insert this, it can be done otherwise but this is probably the simplest):
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI onLoad="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
</customUI>
The way this works is that when the file is opened, the RibbonOnLoad procedure is called, and that procedure then calls the procedure which executes your macro code. Note that unhandled run-time errors may cause the loss of the ribbon object variable which can be disastrous in larger applications, but in your specific use-case this shouldn't be a problem as re-opening the file from disk will always reload the ribbon anyways.
This link also has more info about the basics of ribbon customization, but for your purposes, I think the above code is all you should need.
How can one find a only content (i.e. text) differences between two powerpoint files?
I use PPT 2013. It has a compare tool, but that also finds all text box movements, animation changes, formatting differences etc., which makes it difficult to see whether there are any text changes.
I need to compare "text only" and display any change in text
Context
My client gives me a PPT file. I will format it (color, font, animation etc.), but I'm not supposed to change any text content. If I delete or insert any content by mistake, I'd like to be able to detect that, so I can revert it.
In PowerPoint 2013 you can export the PowerPoint file content to word or a pdf file which you can then use to compare only the text changes:
choose File> Export, Create Handouts, then click
the Create Handouts button.
In the dialog box that opens, choose the Outline Only option and
click OK. Word opens with your text.
Update:
You can run this VBS script to extract the text to a text file then you can compare the two files.
It comes from the tool Beyond Compare 4 which can be downloaded as a trial edition. Download the Additional File Formats for PowerPoint files as well if you just want to compare the text changes from the tool.
' PPT_to_TXT.vbs
'
' Extracts plain text from a PowerPoint document. Requires Microsoft PowerPoint.
' Usage:
' WScript PPT_to_TXT.vbs <input file> <output file>
Option Explicit
' MsoAutomationSecurity
Const msoAutomationSecurityForceDisable = 3
' OpenTextFile iomode
Const ForAppending = 8
Dim App, AutoSec, Doc, FileSys
Set FileSys = CreateObject("Scripting.FileSystemObject")
If FileSys.FileExists(WScript.Arguments(1)) Then
FileSys.DeleteFile WScript.Arguments(1)
End If
Set App = CreateObject("Powerpoint.Application")
On Error Resume Next
App.DisplayAlerts = False
AutoSec = App.AutomationSecurity
App.AutomationSecurity = msoAutomationSecurityForceDisable
Err.Clear
Dim Comment, Shape, Slide, TgtFile
Set Doc = App.Presentations.Open(WScript.Arguments(0), True, , False)
If Err = 0 Then
Set TgtFile = FileSys.OpenTextFile(WScript.Arguments(1), ForAppending, True)
For Each Slide In Doc.Slides
For Each Shape In Slide.Shapes
If Shape.HasTextFrame Then
If Shape.TextFrame.HasText Then
TgtFile.WriteLine Shape.TextFrame.TextRange.Text
End If
End If
Next
For Each Shape In Slide.NotesPage.Shapes
If Shape.HasTextFrame Then
If Shape.TextFrame.HasText Then
TgtFile.WriteLine Shape.TextFrame.TextRange.Text
End If
End If
Next
For Each Comment In Slide.Comments
TgtFile.WriteLine Comment.Author & vbTAB & Comment.DateTime & vbTAB & Comment.Text
Next
Next
TgtFile.Close
Doc.Close
End If
App.AutomationSecurity = AutoSec
App.Quit
I have a VBA program that automates assembly of Word documents from other docs using mostly copy/pasting and bookmark insertions. One template won't save after copying from another document. Here is the code that errors:
'get starting doc w macro (styletemplate)
Set mydoc = wrd.Documents.Open(strformattemplate, False, False)
'this is the base doc with styles - this save works fine
mydoc.SaveAs2 filename:=strNewName,FileFormat:=wdFormatXMLDocumentMacroEnabled
'here's our skeleton this is what we want to copy in
Set skel = wrd.Documents.Open(skelpath)
Set rangetocopy = skel.Range(0, skel.Bookmarks("\endofdoc").End)
rangetocopy.copy ' copy to clipboard
'copy in the skeleton and close it
Set workingrange = mydoc.Range(0, mydoc.Bookmarks("\endofdoc").End)
workingrange.Paste
mydoc.Save 'here's where it's failing
skel.Close False
The second save fails. There is an endless pop-up. The user must abort. I want to emphasize that this code works on all other templates. It appears to fail if one shape (a box that is an underline for a header) is included. Boxes like this appear in the first page of each chapter.