I want to add comments to a powerpoint presentation using VBA. I have this code using For loop but when I run the macro, the comment is adding to the whole presentation, i.e., all slides in the PPT. I wanted to add the comment to a selected slide. Can anyone help?
This is the code using For loop to add some comment:
Sub FictiousNames()
Dim mySlides As Slide
Dim cmtNew As Comment
For Each mySlides In ActivePresentation.Slides
Set cmtNew = mySlides.Comments.Add(Left:=12, Top:=12, _
Author:="Fictious Names", AuthorInitials:="", _
Text:="Please verify if this is an approved fictitious name. Also, you can use the following link to generate fictitious names: https://microsoft.sharepoint.com/sites/LCAWeb/Home/Copyrights-Trademarks-and-Patents/Trademarks/Fictitious-Names-Finder)"
Next mySlides
End Sub
If you want to add a comment to a single (certain) slide, you don't need to use the For loop, just copy the code below:
Sub FictiousNames()
' modify the number in brackets (9) to your slide number
ActivePresentation.Slides(9).Comments.Add 12, 12, "Fictious Names", "", _
"Please verify if this is an approved fictitious name. Also, you can use the following link to generate fictitious names: https://microsoft.sharepoint.com/sites/LCAWeb/Home/Copyrights-Trademarks-and-Patents/Trademarks/Fictitious-Names-Finder)"
End Sub
Related
I need a piece of VB code that will remove all 'titles' from numerous PowerPoint slides. I am using a software to output SPSS data that has a unchangeable default setting to output title headings and I need these removed across 100 of slides. Any ideas?
With Andrew's pointer to the correct method, it's only a few minutes further to this (VBA, not VB.NET, but should be translate-able):
Sub DeleteTitles()
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
' Run this once with the IMMEDIATE window visible
' Verify that what YOU see as titles are actually what PPT sees as titles
Debug.Print oSl.SlideIndex & vbTab & oSl.Shapes.Title.TextFrame.TextRange.Text
' If all's well, comment out the Debug.Print line and uncomment this:
'oSl.Shapes.Title.Delete
Next
End Sub
Do note that what may look like a title to us isn't always a title as far as PPT is concerned. If you put PPT in Outline view, the title (as PPT sees it) will be next to the little slide icons. If there's nothing there, then there's no title and the code above won't work.
I'm still a beginner with VBA and I'm learning a ton from stackoverflow and from general googling.
I'm hitting a wall on this very general task : I'm trying to show a text giving a very general explanation of a chart when it is selected / hovered-over.
The way I was thinking of approaching this was to create a tab with all my chart names (which I already have for other tasks) and create a little text for each of them. A cell (the VBA part) would contain the selected chart name that I could use to do a simple vlookup to fetch the explanation.
I tried to look on google how to do this and I'm usually pretty successful with forums and such, but there are sooooo many information on how to name a chart name based on a cell that I can't seem to find information on how to name a cell based on a chart name.
Edit : was cut off while typing by my newborn waking up, my bad completely forgot to come back and add my attempted code !!!
Sub Test_Chart_Name()
Dim T As String
T = ActiveChart.ChartTitle.Text
Range("AM41").Value = T
End Sub
So far it works when I run it, I do believe I should be able to make it run automatically whenever I select a new chart but right now the wrong behavior is that it display the chart title instead of the name I assigned to it (ie it paste 'Pay per month in dollars' instead of 'Monthly_pay'.
Here's how I approached the request. I wrote a macro that looks up the description of the chart, and displays it in a message box. For each chart you want to run it with, right click the chart, click Assign Macro from the pop-up menu, and select the macro. When you click on the chart, the macro runs. You can also run the macro anytime from Developer tab > Macros or the shortcut Alt+F8.
I set up a lookup range on the active sheet (it could be anywhere) with chart names in the first column and descriptions in the second.
Sub PopUpChartDescription()
Dim rTable As Range, rCell As Range
Dim sName As String, sDescription As String, sCaller As String
On Error Resume Next
sCaller = Application.Caller
If Len(sCaller) > 0 Then ' macro called by clicking on a chart
' activate the chart or it is deactivated after the macro runs
ActiveSheet.ChartObjects(sCaller).Activate
DoEvents
DoEvents
End If
On Error GoTo 0
If Not ActiveChart Is Nothing Then ' so ActiveChart is something, eh?
sName = ActiveChart.Parent.Name
Set rTable = ActiveSheet.Range("DisplayTable") ' my lookup range
Set rCell = rTable.Columns(1).Find(What:=sName) ' find the chart name
If Not rCell Is Nothing Then ' so rCell containing chart name was found
sDescription = rCell.Offset(, 1).Text
' show the description
MsgBox sDescription, vbInformation, "Chart Description"
End If
End If
End Sub
You could try the code below:
Sub Test_Chart_Name()
Dim T As String
T = ActiveChart.Parent.Name
Range("AM41").Value = T
End Sub
Hope that helps!
I have a workbook with a custom right click function that extracts cell values from another workbook depending on what the user chooses. It works very well, I just take in the cell's value from the other workbook. Some cells contain hyperlinks though, and I'd like to import the functional hyperlink, not the value of what's shown in the cell. For example, the following image contains a hyperlink in cell (Y216) of sheet BOS of the input workbook.:
This is an image of the cell I want to copy. It is indeed a hyperlink.
?application.Workbooks(2).Sheets("BOS").Range("Y216").value
returns MKB 70-203 Wicket Shear Pin Detection System, which is indeed correct.
But how do I take the hyperlink's destination? I tried several things including
?application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks.count
returns 0 even though you can see in the image that the hyperlink does have an address. In the same fashion the following sub doesn't enter the For Each because it counts 0 hyperlinks.
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks
Debug.Print HL.Address
Next
End Sub
Expected output would be the link's target J:\SOUM\3191.... as shown in image.
EDIT
If it's important the cell's formula is
=LIEN_HYPERTEXTE("J:\SOUM\3191 M - Old Hickory Dam\11_BOS_FT\02_FT_MECT\21-200 Headcover";"21-200 Headcover")
That's the =HYPERLINK function of French Excel, by the way. I guess in last resort I can take the formula and cut off the function parts to retrieve the link part?
Your command works for me, I don't know why you set the range if you want to loop through all the hyperlinks in the sheet -neither why you set as application. workbooks-, anyways, this worked fine for me:
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
You may get it as well within range methods with the following
ActiveCell.Hyperlinks(1).Address
You may get more info here
Edit:
Probably the count is wrong because of the "application.workbook", try to declare it as a variable instead of using it all over the code
Sub HLtester()
Dim HL As Hyperlink
Dim WBAnalyzed As Workbook: Set WBAnalyzed = Workbooks("MyWB.xlsm")
For Each HL In WBAnalyzed.Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
Edit 2:
This is the approach suggested when the hyperlink it's given by its formula
Sub test()
On Error Resume Next 'means no formula
x = Evaluate(Range("A1").Formula)
x1 = Sheets("Sheet1").UsedRange.Hyperlinks.Count
Debug.Print x
Debug.Print x1
End Sub
PS: I saved my variable declaration -just cause-, but, you should always have a neat control for them and use option explicit at the beginning of the module.
H ey folks,
I've assembled the following code, which copies the first table in my Word document and inserts it at a bookmark position and also adds a formated heading above it via a second bookmark.
To fully automate my Excel application however, I need an advanced functionality of my code. After an insertion was done, the bookmarks have to be relocated to a position directly above the newly inserted table / heading.
Is it possible to relocate these bookmarks programmatically?
Any help is much appreciated.
Best regards,
daZza
Code:
Sub Main()
Dim doc As Word.document
Set doc = GetObject("xxxx.docx")
doc.Tables(1).Range.Copy
doc.bookmarks("AH_Tab").Range.Paste
doc.bookmarks("AH_Header").Range.Text = "Test"
doc.bookmarks("AH_Header").Range.Style = wdStyleHeading1
End Sub
Add the following code before End Sub
Dim tmpRng As Range
Set tmpRng = doc.Bookmarks("AH_Header").Range
doc.Bookmarks.Add "AH_Header", ActiveDocument.Range(tmpRng.Start - 1, tmpRng.Start - 1)
Additional information:
do the same for second bookmark
by changing -1 values you can expand
& move the range where exactly the new bookmark should be placed
I have many word document with lots of bookmarks.
I use VBA code to change these bookmarks with data from a DB.
The problem is, sometimes the users need to edit these documents, and they tend to accidentally delete/change my bookmarks, which leads to the VBA code not recognizing the bookmark anymore.
So basically, what i'm wondering is how i can restrict users from editing my bookmarks in a word document.
I don't need a super secure solution, just enough protection so that the user knows that, "i should not touch this part".
Thanks in advance for your answer..
EDIT:
I was reading on different forums, and came across this,
http://social.msdn.microsoft.com/Forums/office/en-US/f70ca604-bbdb-4b5a-8363-f9e126105e91/writeprotection-of-bookmarks-in-word?forum=vsto
Which sort of does what i want. but was not able to implement/convert it to VBA code. Can someone also see how i maybe can use it?
Thanks again.
EDIT: office 2007 / 2010.
The following idea is tested for Word 2010. It should work for 2007 and 2013 as well but not for 2003.
I would suggest to use ContentControls (called CC further in the text) together with Bookmarks. Next, you will need to control one event which will check if user is selecting inside any of the ContentControl. If so, we will show the message and/or move selection outside protected area.
Step 1st. Each of your bookmarks should be enclosed inside RichText ContentControl. You could do it manually for selected bookmarks or you can run the following simple code to do it for all bookmarks inside your active document.
(Important assumption! there are not any other ContentControls in your document!)
Sub Add_Bookmark_CC()
Dim bookM As Bookmark
For Each bookM In ActiveDocument.Bookmarks
ActiveDocument.ContentControls.add wdContentControlRichText, bookM.Range
Next
End Sub
2nd step. We will control one event: Document_ContentControlOnEnter. Go to ThisDocument module in your Document VBAProject and create the following event (see some comments inside the code):
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
Debug.Print Now, ContentControl.Range.Bookmarks.Count
If ContentControl.Range.Bookmarks.Count > 0 Then
'Optional message box for user
MsgBox "There is bookmark inside this area which you should not change. " & _
vbNewLine & "You will be moved out of this range"
'optionam selection change right after CC area
Dim newPos As Long
newPos = ContentControl.Range.End + 2
ActiveDocument.Range(newPos, newPos).Select
End If
End Sub
Alternative for step 1st and 2nd. If you don't want to use CC event you could add CC to each bookmarks with CC content protection. In this situation you only need 1st step and the following sub:
Sub Add_Bookmark_CC_Protected()
Dim bookM As Bookmark
Dim CC As ContentControl
For Each bookM In ActiveDocument.Bookmarks
Set CC = ActiveDocument.ContentControls.add(wdContentControlRichText, bookM.Range)
CC.LockContents = True
Next
End Sub
Final! As you can see there are some more possible combination of steps 1 and 2.
The following code allows you to delete all CC if you need for any initial tests:
Sub Remove_All_CC()
Dim CC As ContentControl
For Each CC In ActiveDocument.ContentControls
CC.Delete
Next CC
End Sub
Protect your whole document using
'whole document readonly
ThisDocument.Protect Password:="password", NoReset:=False, Type:=wdAllowReadOnly
or
'only write in form fields (can't delete them, just fill them out)
ThisDocument.Protect Password:="mypassword", NoReset:=False, Type:=wdAllowOnlyFormFields
and now give some parts of the document free for editing:
ThisDocument.Bookmarks("myBookmark").Range.Editors.Add wdEditorEveryone
Selection.Range.Editors.Add wdEditorEveryone
Alternative
(not tested)
don't protect your whole document, just restrict the bookmarks you want to lock
ThisDocument.Bookmarks("myBookmark").Range.Editors.Add wdEditorOwners
or
ThisDocument.Bookmarks("myBookmark").Range.Editors.Add "abc#test.com"