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!
Related
I want to have multiple simple buttons in my document when it loads:
Add Patient details
Add history
Print note
Save note
I know the VBA I want to attach to each one of those buttons. But how do I use the code here to make these multiple buttons and assign events to them?
`Sub Test()
'Add a command button to a new document
Dim doc As Word.Document
Dim shp As Word.InlineShape
Set doc = ActiveDocument
Set shp = doc.Content.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1")
shp.OLEFormat.Object.Caption = "Click Here"
'Add a procedure for the click event of the inlineshape
'**Note: The click event resides in the This Document module
Dim sCode As String
sCode = "Private Sub " & shp.OLEFormat.Object.Name & "_Click()" & vbCrLf & _
" MsgBox ""You Clicked the CommandButton""" & vbCrLf & _
"End Sub"
doc.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End Sub`
Consider using ribbon controls instead. If you deal with open XML documents in Word you can insert the ribbon XML markup inside the document and just have event handlers in VBA. You just need to edit the source Office (Word in your case) file.
You can read more about ribbon XML markup in the following articles:
Customizing the 2007 Office Fluent Ribbon for Developers (Part 1 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 2 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 3 of 3)
I am trying to reduce the effort needed to keep a certain slide (lets call it SlideXYZ) up to date. SlideXYZ is an important content slide that can be found in multiple slide decks. I initially created slide objects that updated automatically when a change was made in the "source slide". However, slide objects unfortunately don't contain animations (they are simply a snapshot of the actual slide). I am now trying to write a VBA script that will search and replace SlideXYZ in each deck with a newer version of SlideXYZ. However, the slide number is dynamic (it changes when a new slide is added above). I need a static, constant reference to SlideXYZ.
I thought of copying SlideXYZ into all presentations once and then using the Slide.Name property to find all instances of it once an update is needed.
However, it appears that the Slide.Name is reassigned by powerpoint each time the slide is pasted into a new presentation. I need a reference that will not change so that I can find and replace SlideXYZ.
#Asger's suggestion would work but a more consistent approach (IMO) would be to use tags. Any presentation, slide, or shape on a slide can have one or more bits of text attached in the form of a tag.
For example:
ActivePresentation.Slides(1).Tags.Add "SlideIdentifier", "Bob"
will create a tag named SlideIdentifier with a value of Bob on slide #1 in the current presentation. These tags will travel with the slide, wherever it goes.
This page on the PowerPoint FAQ that I maintain has more info on using tags:
http://www.pptfaq.com/FAQ00815_Working_with_Tags_-and_a_bit_about_Functions-.htm
As you already found out: Neither SlideIndex, SlideNumber, SlideID nor Name can be used to identify a copied slide.
You may work with the "alternative text" of a characteristic shape to identify a slide:
Just do a right mouseclick on the shape and edit its alternative text.
Also slide notes may help to identify a slide.
Following prints some slide information to your debug window:
Private Sub IdentifyMySlide()
Dim myslide As PowerPoint.Slide
For Each myslide In ActivePresentation.Slides
Debug.Print "Index: " & myslide.SlideIndex,
Debug.Print "Number: " & myslide.SlideNumber,
Debug.Print "ID: " & myslide.SlideID,
Debug.Print "Name: " & myslide.Name,
If myslide.Shapes.Count > 0 Then
Debug.Print "Alternative ShapeText: " & myslide.Shapes(1).AlternativeText,
End If
If myslide.HasNotesPage Then
If myslide.NotesPage(1).Shapes.Count > 0 Then
If myslide.NotesPage(1).Shapes(1).HasTextFrame Then
Debug.Print "Notes: " & Left(myslide.NotesPage(1).Shapes(1).TextFrame.TextRange.Text, 10)
Else
Debug.Print
End If
Else
Debug.Print
End If
Else
Debug.Print
End If
Next myslide
End Sub
I have a bunch of images that I would like to apply a specific picture style to - the 4th one that is shown in Word 2010:
I have a macro that will loop through all images, but need to know the possibilities for the shadow.type .
What would be really helpful is a reference to the commands that would be used for each type of picture style, with a visual example.
I don't have VBA, so can't examine the elements of the picture. I have tried various msoShadowxx, but that didn't work.
Is there a good reference with visual examples, or a reference with the settings for each picture style? Or the settings to use for the 4th picture style (shown in the screenshot here)?
Here is the macro code that I use to loop through all the pictures.
Sub BorderMacroshadow()
Dim oInlineShp As InlineShape
For Each oInlineShp In ActiveDocument.InlineShapes
With oInlineShp
.Line.Weight = 1
.Line.ForeColor.RGB = vbBlack
.Shadow.Type = msoShadow14
End With
Next
End Sub
Added
A closer look at the reference for msoShadow shows that it is referring to Picture Effects, Shadows 'dialog', not the 'Picture Styles', which I assumes uses some elements of msoShadow in addition to other elements.
So, I am looking for the elements that are needed to duplicate the 4th 'Picture Style' (see the screenshot). Haven't found those yet.
The msoShadowType enumeration is a group of pre-sets. These aren't necessarily used in the gallery on the Ribbon.
In order to ascertain the settings of any Shadows formatting use the various properties available for Shape.Shadow, such as Transparency, Size, Blur. Inthe UI, these can be seen in Picture Effects, Shadow, Shadow Options of the Picture Style group on the Ribbon.
To determine/set them programmatically, see the following code sample. Note that Angle is not one property, but a combintation of OffsetX and OffsetY.
Sub ShadowProperties()
Dim shp As Word.Shape
Dim shw As Word.ShadowFormat
Set shp = Selection.ShapeRange(1)
Set shw = shp.Shadow
With shw
Debug.Print "Blur: " & .Blur, _
"size: " & .Size, _
"Transparency: " & .Transparency, _
"Offset x: " & .OffsetX, _
"Offset y: " & .OffsetY
End With
End Sub
I am very new with Powerpoint VBA and would like to know if there is a short way to transfer one text range from PowerPoint A to another text range located in Powerpoint B in a specific sequence.
Page a1 = b1
Page a2 = b2
Page a3 = b3
The template is changing and I need to adapt 5 powerpoints of 100 slides so I tought it would be easier with this solution.
Thank you in advance for your help.
PRECISION : I don't want to copy and paste the text range but to copy the text inside the range to put it inside the new range. Please find below the code I already have but It doesnt' Paste it inside my new range.
Sub copier_texte() 'je veux copier le contenu de la forme, et non pas la forme en entier
Dim nb_slide As Integer
nb_slide = ActivePresentation.Slides.Count
With ActivePresentation
.Slides(1).Shapes(2).TextFrame.TextRange.Copy 'je sélectionne uniquement le contenu de la forme
For i = 2 To .Slides.Count
.Slides(i).Select
ActiveWindow.View.Paste
Next i
End With
End Sub
Short Answer:
Is there're a short way to transfer one text range from PowerPoint A to another text range located in Powerpoint B?
I think that there's no short way to do it, but let's try something first!
Long Answer:
Note: This solution based not on your desired behaviour (since it's unclear for me and there're many and more "what if" cases), but on similar problem, so I think that it's legit. Anyway it's a good fundament to start of.
Input:
I dont know how exactly your presentations looks like, so I made a reference one (Presentation A) and a "broken" one (Presentation B). Let's take a look on them:
Presentation A (5 slides: 1x"Title slide" with 2 triangle shapes, 3x"Title and Content" slides, 1x"Section Header" slide):
Presentation B (5 slides: 1x"Title slide" missing triangle shapes, 3x"Title and Content" slides with empty/without shapes(placeholders), 1x"Blank" slide (wrong layout)):
Both presentations are in the same folder:
Desired behaviour:
Some sort of synchronisation, if we miss a shape - then create one and put desired text to it, if there's one - put desired text only (based on Presentations A's shape). There're some "what if" cases in logic:
"What if" the number of slides in each presentation isn't equal? In which order compare slides then? (In our case the number is equal, so in code we drop that part and compare slides pair by pair).
"What if" the compared slides have a different layout? (In our case difference in blank layout, so we can easily handle it, but what we should do in general?)
...and many other cases not considered in this solution
Logic:
Logic is plain and simple. The entry point to our routine is in the Presentation A, since it's an our reference file. From that point we acquire a reference to Presentation B (when opening it), and start iteration in two loops (thru each pair of slides and thru reference shapes).
If we found a "broken" (or not so, there's no check for that) shape by a reference one - we put text and some options in it or create a new one shape (or placeholder) otherwise.
Option Explicit
Sub Synch()
'define presentations
Dim ReferencePresentation As Presentation
Dim TargetPresentation As Presentation
'define reference objects
Dim ReferenceSlide As Slide
Dim ReferenceSlides As Slides
Dim ReferenceShape As Shape
'define target objects
Dim TargetSlide As Slide
Dim TargetSlides As Slides
Dim TargetShape As Shape
'define other variables
Dim i As Long
'Setting-up presentations and slide collections
Set ReferencePresentation = ActivePresentation
With ReferencePresentation
Set TargetPresentation = Presentations.Open(FileName:=.Path & "/Presentation B.pptm", _
WithWindow:=msoFalse)
Set ReferenceSlides = .Slides
End With
Set TargetSlides = TargetPresentation.Slides
'Check slide count
If ReferenceSlides.Count <> TargetSlides.Count Then
'What's a desired behaviour for this case?
'We can add slides to target presentation but it adds complexity
Debug.Print "ERROR!" & vbTab & "Reference And Target slides counts are not equal!"
Else
'"mainloop" for slides
For i = 1 To ReferenceSlides.Count
Set ReferenceSlide = ReferenceSlides(i)
Set TargetSlide = TargetSlides(i)
'Check slide layout
If ReferenceSlide.Layout <> TargetSlide.Layout Then
'What's a desired behaviourfor this case?
'We can change layout for target presentation but it adds complexity
'But let's try to change a layout too, since we have an easy case in our example!
Debug.Print "WARNING!" & vbTab & "Reference And Target slides layouts are not same!"
TargetSlide.Layout = ReferenceSlide.Layout
End If
'"innerloop" for shapes (for placeholders actually)
With ReferenceSlide
For Each ReferenceShape In .Shapes
Set TargetShape = AcquireShape(ReferenceShape, TargetSlide, True)
If TargetShape Is Nothing Then
Debug.Print "WARNING!" & vbTab & "There's no shape like " & ReferenceShape.Name
ElseIf TargetShape.HasTextFrame Then
With TargetShape.TextFrame.TextRange
'paste text
.Text = ReferenceShape.TextFrame.TextRange.Text
'and options
.Font.Size = ReferenceShape.TextFrame.TextRange.Font.Size
.Font.Name = ReferenceShape.TextFrame.TextRange.Font.Name
.Font.Color.RGB = ReferenceShape.TextFrame.TextRange.Font.Color.RGB
'...
End With
End If
Next
End With
Next
End If
'Save and close target presentation
Call TargetPresentation.Save
Call TargetPresentation.Close
End Sub
Function AcquireShape(ByRef ReferenceShape As Shape, ByRef TargetSlide As Slide, _
Optional ByVal CreateIfNotExists As Boolean) As Shape
Dim TargetShape As Shape
With ReferenceShape
'seek for existed shape
For Each TargetShape In TargetSlide.Shapes
If TargetShape.Width = .Width And TargetShape.Height = .Height And _
TargetShape.Top = .Top And TargetShape.Left = .Left And _
TargetShape.AutoShapeType = .AutoShapeType Then
Set AcquireShape = TargetShape
Exit Function
End If
Next
'create new
If CreateIfNotExists Then
If .Type = msoPlaceholder Then
Set AcquireShape = TargetSlide.Shapes.AddPlaceholder(.PlaceholderFormat.Type, .Left, .Top, .Width, .Height)
Else
Set AcquireShape = TargetSlide.Shapes.AddShape(.AutoShapeType, .Left, .Top, .Width, .Height)
End If
End If
End With
End Function
Output:
I know that it's hard to find any difference by a screenshot (it's can be even photoshoped, anyway there're a few difference for that purpose), but for a full answer, here it is:
Conclusion:
As you see, it isn't a hard task to achieve something similar to your desire, but complexity of solution depends on inputs and on "what if" cases, hence there's no short way to overcome this task in general (in my humble opinion). Cheers!
Your question has a number of different interpretations, below is my attempt to answer what I believe the question is. There are a number of stage to this solution.
1. Ensure we save the VBA we write
Firstly, we have to assume a master presentation, that is one that will hold the values to be copied into all others. This will need to be saved as a macro enabled presentation (pptm) to allow us to save our VBA. This is done via File > Save-As and while selecting the save location choose PowerPoint Macro-Enabled Presentation in the Save as type box.
2. Enable Windows scripting runtime
Within the pptm 'master' presentation that we now have, open the VBA IDE (Alt+F11). In the menu bar select Tools > References... and tick Microsoft Scripting Runtime from the list that is presented. Click OK to close the references dialog box with your tick remembered. This is needed for some error handling in the code, it checks to see if the presentation exists before trying to open it.
3. Insert the provided code
Right-click on VBAProject in the upper right area (the Project explorer) and select Insert > Module.
In the main editing area paste the below (I have added commenting to describe what is happening): -
Option Explicit
Public Sub Update()
Dim AryPresentations(4) As String
Dim LngPID As Long
Dim FSO As New FileSystemObject
Dim PP_Src As Presentation
Dim PP_Dest As Presentation
Dim Sld_Src As Slide
Dim Sld_Dest As Slide
Dim Shp_Src As Shape
Dim Shp_Dest As Shape
Dim LngFilesMissing As Long
Dim BlnWasOpen As Boolean
'If there is an error, this will handle it and stop the process
On Error GoTo ErrorHandle
'Increase the size of AryPresentations and and the paths as shown in the example below
AryPresentations(0) = "C:\Users\garye\Desktop\PP2.pptx"
AryPresentations(1) = "C:\Users\garye\Desktop\PP3.pptx"
AryPresentations(2) = "C:\Users\garye\Desktop\PP4.pptx"
AryPresentations(3) = "C:\Users\garye\Desktop\PP5.pptx"
AryPresentations(4) = "C:\Users\garye\Desktop\PP6.pptx"
'PP_Src is this, our 'master' presentation
Set PP_Src = ActivePresentation
'This loops through each item in AryPresentations
For LngPID = 0 To UBound(AryPresentations, 1)
'We rememeber if you had it open already as if you did, then we won't close it when we are done
BlnWasOpen = False
'Check all currently open presentations to see if one if the presentation we are due to update
For Each PP_Dest In PowerPoint.Presentations
If Trim(UCase(PP_Dest.FullName)) = Trim(UCase(AryPresentations(LngPID))) Then Exit For
Next
'If it was not already open, check it exists and if it does, then open in
If PP_Dest Is Nothing Then
If FSO.FileExists(AryPresentations(LngPID)) Then
Set PP_Dest = PowerPoint.Presentations.Open(AryPresentations(LngPID))
End If
Else
BlnWasOpen = True
End If
If PP_Dest Is Nothing Then
Debug.Print "File note found"
LngFilesMissing = LngFilesMissing + 1
Else
'The below connects to the slide (Sld_Src) you want to pick up from, the shape (Shp_Src) you want to pick up from and then
'places it in the slide (Sld_Dest) you want it to go to into the shape (Shp_Dest) you want it to go in to
Set Sld_Src = PP_Src.Slides(1)
Set Sld_Dest = PP_Dest.Slides(1)
Set Shp_Src = Sld_Src.Shapes(1)
Set Shp_Dest = Sld_Dest.Shapes(1)
Shp_Dest.TextFrame.TextRange.Text = Shp_Src.TextFrame.TextRange.Text
Set Shp_Dest = Nothing
Set Shp_Src = Nothing
Set Sld_Dest = Nothing
Set Sld_Src = Nothing
'Repeat the above for each piece of text to copy
'Finally save the changes
PP_Dest.Save
'Close the presentation if it was not already open
If Not BlnWasOpen Then PP_Dest.Close
End If
Next
MsgBox "Process complete. Number of missing files: " & LngFilesMissing, vbOKOnly + vbInformation, "Complete"
Exit Sub
ErrorHandle:
MsgBox "There was an error: - " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, "Error"
Err.Clear
End Sub
4. Customise code
You'll want to add the paths and location of the changes in and then it should run.
I'm struggling to find a way to create a link to another slide with VSTO for powerpoint, does anybody know how to do it ? No way to find any solution on the internet...
Translate this from VBA to VSTO and you should be good to go. Pass it references to the shape you want to apply the link on, and the slide you want to link to.
Sub MakeLink(osh As Shape, oLinkTargetSlide As Slide)
With osh.ActionSettings(1)
.Action = ppActionHyperlink
.Hyperlink.Address = ""
.Hyperlink.SubAddress = oLinkTargetSlide.SlideID & "," & oLinkTargetSlide.SlideIndex & ","
End With
End Sub
You might instead want to declare oSh as Object; then you could pass the Sub either a shape or a TextRange to apply the link to.