How to add a Add ins menu tab to Power Point 2007? - powerpoint

I am working with Power Point 2007 but there is no Add Ins menu tab and I can not find how to add it.

When PPT 2007 and onward runs code that creates "legacy" command bars or menu modifications, it automatically adds the Add-ins tab to the ribbon and puts the command bars/menu changes there. Here's some simple example code. You can run it as is, or save it as an add-in. Once the add-in is loaded, the Auto_Open code will run every time PPT starts up.
Sub Auto_Open()
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String
' Give the toolbar a name
MyToolbar = "Kewl Tools"
On Error Resume Next
' so that it doesn't stop on the next line if the toolbar's already there
' Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
' The toolbar's already there, so we have nothing to do
Exit Sub
End If
On Error GoTo ErrorHandler
' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
' And set some of the button's properties
With oButton
.DescriptionText = "This is my first button"
'Tooltip text when mouse if placed over button
.Caption = "Do Button1 Stuff"
'Text if Text in Icon is chosen
.OnAction = "Button1"
'Runs the Sub Button1() code when clicked
.Style = msoButtonIcon
' Button displays as icon, not text or both
.FaceId = 52
' chooses icon #52 from the available Office icons
End With
' Repeat the above for as many more buttons as you need to add
' Be sure to change the .OnAction property at least for each new button
' You can set the toolbar position and visibility here if you like
' By default, it'll be visible when created. Position will be ignored in PPT 2007 and later
oToolbar.Top = 150
oToolbar.Left = 150
oToolbar.Visible = True
NormalExit:
Exit Sub ' so it doesn't go on to run the errorhandler code
ErrorHandler:
'Just in case there is an error
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
End Sub
Sub Button1()
' This code will run when you click Button 1 added above
' Add a similar subroutine for each additional button you create on the toolbar
' This is just some silly example code.
' You'd put your real working code here to do whatever
' it is that you want to do
MsgBox "Stop poking the pig!"
End Sub

Related

Not able to select WpfMenu Button inside WpfTable

I need to perform Right Click in the Middle of WpfTable, then WpfMenu appears and I want to select a particular Option from it.
See the Screenshot for more details:-
Here is Code I am trying:-
Function IncidentCancellAllActions()
Dim Rowcnt
Rowcnt = SwfWindow("VisionCommandClient").SwfObject("VisionCC_Incident_ActionsTab_SWO").WpfWindow("VisionCC_Incident_ActionsTab_WpfWin").WpfTable("VisionCC_Incident_ActionsTab_WpfTable").RowCount
If Rowcnt > 0 Then
SwfWindow("VisionCommandClient").SwfObject("VisionCC_Incident_ActionsTab_SWO").WpfWindow("VisionCC_Incident_ActionsTab_WpfWin").WpfTable("VisionCC_Incident_ActionsTab_WpfTable").ActivateCell
SendFromKeyboard("1-SHFT-F10")
wait 5
'SwfWindow("VisionCommandClient").WpfWindow("VisionCC_ResourceStatusList_WpfWin_2").WpfMenu("VisionCC_Action_WPM").Select "Cancel All"
msgbox SwfWindow("VisionCommandClient").WpfWindow("VisionCC_ResourceStatusList_WpfWin_2").WpfMenu("VisionCC_Action_WPM").ShowContextMenu
SwfWindow("VisionCommandClient").WpfWindow("VisionCC_ResourceStatusList_WpfWin_2").WpfMenu("VisionCC_Action_WPM").Select "Cancel All"
wait 2
Else
Exit Function
End If
End Function
After right Click, It is not clicking on WpfMenu option "Cancell All".
Had this problem and currently working around the problem using '.Type' method:
WpfWindow("MyWindow").WpfButton("Item-Menu").ShowContextMenu
WpfWindow("MyWindow").WpfMenu("List-Menu").Exist(1)
menuItems = WpfWindow("MyWindow").WpfMenu("List-Menu").GetVisibleText
menuItems = replace(menuItems, chr(13),"")
for each menuItem in split(menuItems,chr(10))
WpfWindow("SAP Work Manager").WpfMenu("List-Menu").Type micDwn
Wait 0,400
If instr(1, menuItem, "MenuItemToClick") > 0 Then 'replace MenuItemToClick with the menu item text.
Exit for
End If
next
WpfWindow("SAP Work Manager").WpfMenu("List-Menu").Type micReturn
This works as long as the order of menu items doesn't change. Waits are included because ive noticed HP-UFT doesn't check that the object is fully loaded before doing the next task.

Window("hwnd:=" & handle).Restore is causing Object not visible error

I have an application that opens up some new tabs. I'm trying to cycle through these tabs, look at them, and then close them.
Dim tab_children, oDesc
Set oDesc = Description.Create
oDesc("micclass").value = "Browser"
Set tab_children = Desktop.ChildObjects(oDesc)
Dim title, handle, cTime
For i = 0 To tab_children.Count-1 Step 1
title = tab_children(i).GetROProperty("title")
handle = tab_children(i).GetROProperty("hwnd")
Window("hwnd:=" & handle).Restore
msgbox title & ": " & handle
Next
When we try to execute the .Restore, I receive an "object not visible" error. The tab that we're trying to restore is not the one that has focus, could that be the issue and if so how can we resolve it? I was under the impression that .Restore would bring that tab into focus based off of this thread, http://www.advancedqtp.com/old_forums/viewtopic.php?t=1970
The IDE I'm using is QTP, the Browser is IE.
A potential work around that I've been thinking about:
After the application opens up the new tabs, the last opened tab has focus. If we close that one, the 2nd to last has focus, all the way down to the original application's tab. Perhaps there's a way to utilize this information.
Restore has worked for me in the past, try using Activate-
Window("hwnd:=" & handle).Activate
Edited: Just tested the following and its working on my machine-
'Create Browser Descriptor
Set oBrowser=Description.Create
oBrowser("micclass").Value="Browser"
'Get the child objects
Set oBrowser=Desktop.ChildObjects(oBrowser)
totalcount = oBrowser.Count-1
For i=0 to totalcount
If Browser("micclass:=Browser", "index:="&i).Exist(0) Then
'get the hwnd everytime there's an iteration
ohwnd= Browser("micclass:=Browser", "index:=" & i).GetROProperty("hwnd")
'For debugging purposes
name = Browser("hwnd:="&ohwnd).GetROProperty("title")
msgbox name
Set oBrowser=Browser("hwnd:="&ohwnd)
'Page descriptor
Set oPage=Description.Create
oPage("micclass").Value="Page"
Set oPage=Browser("hwnd:="&ohwnd).ChildObjects(oPage)
For n=0 to oPage.Count-1
If oPage(n).Exist(0) Then
oBrowser.Close
Exit For
End If
Next
End If
Next
If you want to close only a particular page you can use the GETROPREPERTY("Title") in the If loop - If oPage(n).Exist(0)

Excel VBA: end user select image on computer and submit on user form

I have a userform with a bunch of textboxes. End user inputs test data into form and after clicking "Submit" button, this info is saved to an excel sheet. I am wondering how to make it possible for user to input images from their computer into the form.
Requirements: End user be able to select an image from their computer and click submit on the form to have it inserted into an excel sheet.
Private Sub CommandButton3_Click()
Dim image As FileDialog
Set image = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedPicture As Variant
With image
If .Show = -1 Then
For Each vrtSelectedPicture In .SelectedItems
'Show path in textbox
TextBox71.Text = .SelectedItems(1)
Next vrtSelectedPicture
'The user pressed Cancel.
Else
End If
End With
'Set the object variable to Nothing
Set image = Nothing
End Sub
Sure, here is a sample code that may give you an idea about FileDialog.
Private Sub CommandButton1_Click()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Submit"
.Title = "Select an image file"
.Filters.Add "Image", "*.gif; *.jpg; *.jpeg", 1
If .Show = -1 Then
' file has been selected
' e.g. show path in textbox
Me.TextBox1.Text = .SelectedItems(1)
' e.g. display preview image in an image control
Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(.SelectedItems(1))
Else
' user aborted the dialog
End If
End With
End Sub

Run VBA on any PowerPoint to change the LanguageID

I'm trying to create a toolbar with a button that will change the LanguageID for all shapes and text boxes in a PowerPoint document to EnglishUS. This is to fix a problem where if someone spell-checks a document using another language (in this instance, French), that language is embedded into the .ppt file itself. When another user tries to spell-check the same area using another language, say English, the words the spell checker suggests are in the original language. For instance, it tried to correct the word 'specified' to 'specifie', a French word. From what I've read, the only way to fix this language issue is with a VBscript, and the only way to run a VBscript in Powerpoint without embedding it into a .ppt and loading that file every time is by creating an add-in with a toolbar button to run the macro, also using VBS. Below is the code which I've taken from various sources, and when I tried to put it together, it didn't work (although it did compile). If someone could take a look, I'm sure its a simple syntax error or something like that, it would be a HUGE help. Thanks in advance!!
By the way if anyone knows an easier way to run a macro in PPT without having to open a certain PPT every time, I'm ALL ears.
and now, the script:
Sub Auto_Open()
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String
''# Give the toolbar a name
MyToolbar = "Fix Language"
On Error Resume Next
''# so that it doesn't stop on the next line if the toolbar's already there
''# Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
''# The toolbar's already there, so we have nothing to do
Exit Sub
End If
On Error GoTo ErrorHandler
''# Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
''# And set some of the button's properties
With oButton
.DescriptionText = "Fix Language for Spell Check"
''# Tooltip text when mouse if placed over button
.Caption = "Click to Run Script"
''# Text if Text in Icon is chosen
.OnAction = "Button1"
''# Runs the Sub Button1() code when clicked
.Style = msoButtonIcon
''# Button displays as icon, not text or both
.FaceId = 59
End With
''# Repeat the above for as many more buttons as you need to add
''# Be sure to change the .OnAction property at least for each new button
''# You can set the toolbar position and visibility here if you like
''# By default, it'll be visible when created
oToolbar.Top = 150
oToolbar.Left = 150
oToolbar.Visible = True
NormalExit:
Exit Sub ''# so it doesn't go on to run the errorhandler code
ErrorHandler:
''# Just in case there is an error
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
End Sub
Sub Button1()
''# This is the code to replace the LanguageID throughout the ppt
Option Explicit
Public Sub ChangeSpellCheckingLanguage()
Dim j As Integer, k As Integer, scount As Integer, fcount As Integer
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k) _
.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS
End If
Next k
Next j
End Sub
End Sub
The answer is quite obvious if it is not clear yet.
As you can see the sub Button1() encapsulates another sub. Thus, I advise you to remove the call ChangeSpellingCheckingLanguage and the last End sub, then your code will work.
This may be an incredibly late answer, but I just solved this problem using VBScript (which can be run outside of powerpoint). The script as written will change the language of each powerpoint file in a given directory (and subdirectories) to English. Here's the script:
Option Explicit
'microsoft office constants
Const msoTrue = -1
Const msoFalse = 0
Const msoLanguageIDEnglishUS = 1033
Const msoGroup = 6
'starting folder (current folder)
Const START_FOLDER = ".\"
'valid powerpoint file extensions
Dim FILE_EXTENSIONS : FILE_EXTENSIONS = Array("pptx", "pptm", "ppt", "potx", "potm", "pot")
'desired language for all Text
Dim DESIRED_LANGUAGE : DESIRED_LANGUAGE = msoLanguageIDEnglishUS
'VBScript file system objects for starting folder
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartingFolder : Set objStartingFolder = objFSO.GetFolder(START_FOLDER)
IterateContainingItems objStartingFolder
'recursive subroutine to iterate each file in specified folder and all subfolders
Sub IterateContainingItems(objCurrentFolder)
Dim colFiles : Set colFiles = objCurrentFolder.Files
Dim objCurrentFile
For Each objCurrentFile in colFiles
ReportInfo(objCurrentFile)
Next
Dim colFolders : Set colFolders = objCurrentFolder.SubFolders
Dim objNextFolder
For Each objNextFolder in colFolders
IterateContainingItems objNextFolder
Next
End Sub
'subroutine executed for every file iterated by IterateContainingItems subroutine
Sub ReportInfo(objCurrentFile)
Dim strPathToFile
strPathToFile = objFSO.GetAbsolutePathName(objCurrentFile.Path)
If isPowerpointFile(strPathToFile) Then
Dim objPowerpointApp, objPresentations, objPresentation, objSlides, intSlideCount
set objPowerpointApp = CreateObject("Powerpoint.Application")
set objPresentations = objPowerpointApp.Presentations
Set objPresentation = objPresentations.Open(strPathToFile, msoFalse, msoFalse, msoFalse)
Set objSlides = objPresentation.Slides
intSlideCount = objSlides.Count
ResetLanguage objPresentation
objPresentation.Save
objPresentation.Close
objPowerpointApp.Quit
End If
End Sub
'check if given filepath specifies a powerpoint file as described by the "constant" extension array
Function isPowerpointFile(strFilePath)
Dim strExtension, found, i
strExtension = objFSO.GetExtensionName(strFilePath)
found = false
for i = 0 to ubound(FILE_EXTENSIONS)
if FILE_EXTENSIONS(i) = strExtension then
found = true
exit for
end if
next
isPowerpointFile = found
End Function
'finds every shape in the entire document and attempts to reset its LanguageID
Sub ResetLanguage(objCurrentPresentation)
Dim objShape
'change shapes from presentation-wide masters
If objCurrentPresentation.HasHandoutMaster Then
For Each objShape in objCurrentPresentation.HandoutMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasNotesMaster Then
For Each objShape in objCurrentPresentation.NotesMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasTitleMaster = msoTrue Then
For Each objShape in objCurrentPresentation.TitleMaster.Shapes
ChangeLanguage objShape
Next
End If
'change shapes from each design's master
Dim tempDesign
For Each tempDesign in objCurrentPresentation.Designs
For Each objShape in tempDesign.SlideMaster.Shapes
ChangeLanguage objShape
Next
Next
'change shapes from each slide
Dim tempSlide
For Each tempSlide in objCurrentPresentation.Slides
For Each objShape in tempSlide.Shapes
ChangeLanguage objShape
Next
If tempSlide.hasNotesPage Then
For Each objShape in tempSlide.NotesPage.Shapes
ChangeLanguage objShape
Next
End If
Next
End Sub
'if the given shape contains a text element, it checks and corrects the LanguageID
'if the given shape is a group, it iterates through each element in the group
Sub ChangeLanguage(objShape)
If objShape.Type = msoGroup Then
Dim objShapeGroup : Set objShapeGroup = objShape.GroupItems
Dim objShapeChild
For Each objShapeChild in objShapeGroup
ChangeLanguage objShapeChild
Next
Else
If objShape.HasTextFrame Then
Dim intOrigLanguage : intOrigLanguage = objShape.TextFrame.TextRange.LanguageID
If Not intOrigLanguage = DESIRED_LANGUAGE Then
If objShape.TextFrame.TextRange.Length = 0 Then
objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]"
End If
objShape.TextFrame.TextRange.LanguageID = DESIRED_LANGUAGE
If objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]" Then
objShape.TextFrame.TextRange.Text = ""
End If
End If
End If
End If
End Sub
To run it, just copy and paste the code into a text editor and save it as "script_name.vbs" in the directory with your powerpoint files. Run it by double clicking the script and waiting.
To load a macro every time PowerPoint is opened, you will want to create a PowerPoint AddIn. Microsoft has provided step-by-step guide for Office XP. For Office 2007 and newer, AFAIK the following steps will do that:
Save file as *.ppam into the directory it suggests (%APPDATA%\Microsoft\AddIns)
Open the Settings (click the office button in the top left corner and select "PowerPoint Options"), select the "Add-Ins" page, choose "PowerPoint Add-Ins" in the drop-down behind "Manage" and click the "Go" button. A dialog opens. Selecting "Add New" brings up a file picker dialog. You should be able to select the file there.
You can also use the Office Custom UI Editor to create ribbons.
However, I have already created such a Language Fixer Add-In for current versions of PowerPoint, and I have put it up for free download for personal use: PowerPoint Language Fixer by Jan Schejbal

Macro to wrap selected text with tags in Visual Studio

I realize that I may be being a bit lazy, but does anyone know of a Visual Studio macro, where I can select some text inside of the Visual Studio IDE, click a button, and have it wrap the selected text with tags? It would generate something like:
<strong>My Selected Text</strong>
I would even be up for creating a macro, just not sure where to exactly start!
The code to do so is rather simple:
Sub SurroundWithStrongTag()
DTE.ActiveDocument.Selection.Text = "<strong>" + DTE.ActiveDocument.Selection.Text + "</strong>"
End Sub
Now, if you don't know much about macros here's how to add it:
First you need open the macros IDE, click Tools->Macros->Macros IDE...
Next, we will add a module for your custom macros. Right click on "MyMacros" in the Project Explorer, click Add->Add Module..., type in an appropriate name then click "Add".
Now paste the function inside the module, making copies for any other tags you want
Save and close the macros IDE
To hook the macro up to a button:
Click Tools->Customize...
Click New..., type in an appropriate name, click OK. An empty toolbar should be visible (you may have to move the window to see it)
Click the Commands tab, and select "Macros" in categories
Find the macros created before and drag them over to the toolbar
Right click the buttons to change settings (such as displaying an icon instead of text)
I know this is an old topic, but maybe someone finds this useful.
I have the following set up:
Sub WrapInH1()
WrapInTag("h1")
End Sub
Sub WrapInP()
WrapInTag("p")
End Sub
Sub WrapInStrong()
WrapInTag("strong")
End Sub
Sub WrapInTag()
WrapInTag("")
End Sub
Sub WrapInTag(ByVal tagText As String)
EnableAutoComplete(False)
If tagText.Length = 0 Then
tagText = InputBox("Enter Tag")
End If
Dim text As String
text = DTE.ActiveDocument.Selection.Text
text = Regex.Replace(text, vbCrLf & "$", "") 'Remove the vbCrLf at the end of the line, for when you select the line by clicking in the margin, otherwise your closing tag ends up on it's own line at the end...
DTE.ActiveDocument.Selection.Text = "<" & tagText & ">" & text & "</" & tagText & ">" & vbCrLf
EnableAutoComplete(True)
End Sub
Private Sub EnableAutoComplete(ByVal enabled As Boolean)
Dim HTMLprops As Properties
Dim aProp As EnvDTE.Property
HTMLprops = DTE.Properties("Texteditor", "HTML Specific")
aProp = HTMLprops.Item("AutoInsertCloseTag")
aProp.Value = enabled
End Sub
Dim HTMLprops As Properties = DTE.Properties("Texteditor", "HTML Specific")
Dim aProp As EnvDTE.Property = HTMLprops.Item("AutoInsertCloseTag")
aProp.Value = False
Original answer
If you want an out of the box solution, Visual Studio 2015 comes with a new shortcut, Shift+Alt+W wraps the current selection with a div. This shortcut leaves the text "div" selected, making it seamlessly changeable to any desired tag. This coupled with the automatic end tag replacement makes for a quick solution.
Example
Shift+Alt+W > strong > Enter

Resources