Error while running a macro from the ribbon - vba

I am using Microsoft Word 2010. I've written a code using VBA editor which is used for saving the documents I edit. Basically, it opens the save as file dialog and puts in a name based on a string which is defined by some text in the document and user input via a Inputbox.
I can successfully run it when I click the view macrocomands tab and execute the macrocomand from there, but if I put a shortcut on a ribbon, the file is instantly saved in C:\Users\Username\Documents with the first line of the document.
Sub SaveAs()
'Preia numarul dosarului in numele fisierului
Dim oRng As Range
Dim Nrdosar As String
Dim sTags As String
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Execute FindText:="Dosar nr. ", Forward:=True, _
Format:=False, Wrap:=wdFindStop
End With
oRng.Collapse 0
Nrdosar = oRng.Paragraphs(1).Range.Text
Nrdosar = Replace(Nrdosar, "Dosar nr. ", "")
Nrdosar = Replace(Nrdosar, "DOSAR NR. ", "")
Nrdosar = Replace(Nrdosar, "/4/", "-")
Nrdosar = Replace(Nrdosar, "/", "-")
Nrdosar = Replace(Nrdosar, "*", "")
Nrdosar = Replace(Nrdosar, Chr(13), "")
MsgBox Nrdosar
sTags = InputBox("Introduceti cuvinte cheie separate de virgula")
With Dialogs(wdDialogFileSaveAs)
.Name = Nrdosar & " " & sTags & ".docx"
.Show
End With
End Sub
I have exported the ribbon shortcuts to try and understand the problem
<mso:cmd app="Word" dt="1" />
<mso:customUI xmlns:x1="http://schemas.microsoft.com/office/2009/07/customui/macro" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui"><mso:ribbon>
<mso:qat><mso:sharedControls>
<mso:control idQ="mso:FileNewDefault" visible="false"/><mso:control idQ="mso:FileOpen" visible="false"/>
<mso:control idQ="mso:FileSendAsAttachment" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:FilePrintQuick" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:PrintPreviewAndPrint" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:SpellingAndGrammar" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:TableDrawTable" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:FileOpenRecentFile" visible="false" insertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:Undo" visible="true" insertBeforeQ="mso:FileSave"/><mso:control idQ="mso:RedoOrRepeat" visible="true" InsertBeforeQ="mso:FileSave"/>
<mso:control idQ="mso:FileSave" visible="true"/>
<mso:button idQ="x1:SaveAs_1" visible="true" label="Normal.NewMacros.SaveAs" imageMso="ListMacros" onAction="SaveAs"/>
</mso:sharedControls></mso:qat>
<mso:tabs>
<mso:tab idQ="mso:TabHome">
<mso:group id="mso_c1.-D823CC6" label="Auto" autoScale="true">
<mso:gallery idQ="mso:AutoTextGallery" showInRibbon="false" visible="true"/>
<mso:control idQ="mso:TableColumnsDelete" visible="true"/>
<mso:control idQ="mso:TableRowsDelete" visible="true"/>
<mso:button idQ="x1:SaveAs_0_102AE36C" label="Normal.NewMacros.SaveAs" imageMso="ListMacros" onAction="SaveAs" visible="true"/>
</mso:group>
</mso:tab><mso:tab id="mso_c1.5F8A243" label="FilÄ nouÄ">
<mso:group id="mso_c2.5F8A243" label="Grup nou" autoScale="true">
<mso:control idQ="mso:DateAndTimeInsert" visible="true"/>
</mso:group>
</mso:tab>
</mso:tabs>
</mso:ribbon>
</mso:customUI>
I cannot imagine why the result is different when running the macrocomand from the View Macrocomands tab versus the shortcut that I put in a ribbon.
I believe that there is no problem with the VBA code itself and that there is some kind of a bug.
I would like to be able to run the VBA code using a shortcut.
Thank you!

SaveAs is a built-in command in Word (as in File/Save As). So sending the command to run a macro with this name is by-passing the actual macro and executing Word's built-in command.
Assigning a different name (non-reserved) to the macro should fix the problem.

The problem or bug was in the name of the Macro. I have changed the first line from:
Sub SaveAs()
to
Sub SaveDoc()
I still don't understand this behavior, but I wanted to share the workaround.

Related

Get value from Ribbon Control (Drop Down or Combo Box etc.)

Is it possible to design a ribbon addin with either drop down list or combo box and then use the values to run a subroutine?
I created a PowerPoint Ribbon Addin with a DropDown with items showing as "Depart 1", "Depart 2" & "Depart 3" and one button to import from an Excel file.
The idea is user can select which department to prepare slides for. Then they can run the report which will copy the charts from the designated Excel file.
Below is example code to show what I am trying to do.
When I select department in the dropdown list; I get the message which department is selected from the DropDown. But when I tried to use that as a variable, my code did not recognise it.
XML code for Ribbon Addin:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon>
<tabs>
<tab id="CustomTab" label="TestLabel">
<group id="SampleGroup" label="BU Selection">
<dropDown id="DdropDown" label="Select Dept" onAction="DReportSelection" getSelectedItemIndex = "DropDown_OnGetSelectedItemIndex">
<item id="item1" label="Depart 1" />
<item id="item2" label="Depart 2" />
<item id="item3" label="Depart 3" />
</dropDown>
</group >
<group id="SampleGroup1" label="TestLabel">
<button id="Button" label="Import Excel" imageMso="MicrosoftExcel" screentip="Import Data from Excel" size="large" onAction="ExcelImport" />
</group >
</tab>
</tabs>
</ribbon>
</customUI>
VBA code in my presentation.
Sub BUReportSelection(control As IRibbonControl, ID As String, selectedindex As Variant)
Dim department As String
department = Choose(selectedindex + 1, "Depart 1", "Depart 2", "Depart 3")
MsgBox department & " is selected ", vbInformation
End Sub
Sub ExcelImport()
If department = "Depart 1" Then
Call Macro4Department 1
End If
If department = "Depart 2" Then
Call Macro4Department 2
End If
If department = "Depart 3" Then
Call Macro4Department 3
End If
End Sub
Note: code just to demonstrate.
VBA can't access the Ribbon directly. Your dropdown is triggering a callback to DReportSelection. Instead it should trigger a callback to a macro that stores the selected item (the id, not the label i.e. item1, item2, or item3) in a global variable. Then the DReportSelection macro (I assume that's what's in the second listing) can read that variable and call the relevant macro.

Compile Error in Hidden Module: Module 1

I've an Addin for Excel-2010 in VBA. If I execute the code from the VBA editor it works fine. But when I execute the macro using the button in the Ribbon generated for the Addin it throws this error: Compile Error in Hidden Module: Module 1
My code:
Sub QE_eventhandler(control As IRibbonControl)
If MsgBox("Esta acción no se podrá deshacer. ¿Desea Continuar?", vbExclamation + vbOKCancel, "Confirmar -Quitar Espacios-") = vbOK Then
QuitaEspacios
End If
End
Sub QuitaEspacios()
Dim celda As Range
For Each celda In Selection
If TypeName(celda.Value) = "String" Then
celda.Value = Application.WorksheetFunction.Trim(celda.Value)
End If
Next
End Sub
The code generated with the Custom UI Editor:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon>
<tabs>
<tab id="customTab" label="GARSA Tools">
<group id="customGroup1" label="Reformateo Texto">
<button id="customButton3" label="Quitar Espacios" size="large" onAction="QE_eventhandler" imageMso="TextEffectTracking" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
You are missing an End Sub at the end of the callback - you just have End:
Sub QE_eventhandler(control As IRibbonControl)
If MsgBox("Esta acción no se podrá deshacer. ¿Desea Continuar?", vbExclamation + vbOKCancel, "Confirmar -Quitar Espacios-") = vbOK Then
QuitaEspacios
End If
End Sub
Check out the following links which describe a similar issue:
You receive a "Compile error in hidden module" error message when you start Word or Excel
compile error in Excel

Creating a kml file using vba - Not saving properly

I'm attempting to use VBA to take in some coordinates from a SQL table, create some code that sits in an excel tab that is then saved as a .kml file and open the file in Google Earth.
When the code creates the kml file it then opens GE but nothing happens (as in, it doesn't show the coordinates in the sidebar and doesn't point to anything).
Similarly, when I navigate to the kml file manually and open it in GE, nothing happens.
However, if I go back to the excel tab that is being saved as .kml, copy/paste the code into notepad and manually save as .kml, the file opens in GE and displays the coordinates from the code.
I have stripped the code back to the minimum required to highlight my problem (see below).
From what I've observed it would seem I'm not saving the file properly.
Sub Mapping()
Range("A1").Value = "<?xml version=""1.0"" encoding=""UTF-8""?>"
Range("A2").Value = "<kml xmlns=""http://www.opengis.net/kml/2.2"""
Range("A3").Value = "xmlns:gx=""http://www.google.com/kml/ext/2.2"" "
Range("A4").Value = "xmlns:kml=""http://www.opengis.net/kml/2.2"" "
Range("A5").Value = "xmlns:atom=""http://www.w3.org/2005/Atom"">"
Range("A6").Value = "<Document>"
Range("A7").Value = " <Placemark> <name>" & "Name here..." & "</name> <description>" & "Testing" & "</description>"
Range("A8").Value = "<Style> <IconStyle> <scale>1.2</scale> <Icon> <href>http://maps.google.com/mapfiles/kml/pal4/icon16.png</href> </Icon> </IconStyle> </Style> "
Range("A9").Value = "<Point> <coordinates>" & " -114.232195463845,53.0160219116952,0" & "</coordinates> </Point> </Placemark>"
Range("A10").Value = "</Document> </kml> "
ActiveSheet.SaveAs "C:\Users\user\Desktop\KMLTESTING4.kml"
Dim KMLLoc As String
KMLLoc = "C:\Users\user\Desktop\KMLTESTING4.kml"
Call Shell("explorer.exe " & KMLLoc, vbNormalFocus)
End Sub
Added FileFormat:=xlTextPrinter to the end of my save and now working fine.

Create a new Ribbon tab with vba that only appears selecting certain shapes

I want to make appear a new ribbon tab that only appears when I select a shape that I want. I know to make normal tabs using Custom UI Editor For Microsoft Office or also with VBA using the following example:
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:
But I want to make it appear and disappear in certain moments. For example in Powerpoint when you select a video, there appears 2 new tabs (FORMAT AND PLAYBACK) with options for videos. When you select another shape that is not video this tab just disappear and other tabs appears with the proper options for the shape that you select and when you don't select any shape those special tabs just disappear.
Is it possible to make it using VBA?
Yes this is possible. There are three main things you need to implement to make this occur.
Enable Events in the add-in to capture the selection of a shape. When the shape selection event fires, this will be called to determine if the shape is what you want to show your tab etc.
In the XML that defines the ribbon ensure you have a 'Visible' callback function.
VBA code for the callback function of 'Visible'.
For example
In a module named 'Ribbon'
Private theRibbon As IRibbonUI 'Holds a variable for the ribbon when loaded on startup
Private MyTag As String 'A variable to tell the ribbon to show or what Tag to hide
'Callback for the Ribbon loading from XML
Public Sub RibbonOnLoad(Ribbon As IRibbonUI)
Set theRibbon = Ribbon
MyTag = "show"
End Sub
'Get visible callback function.
Sub GetVisible(control As IRibbonControl, ByRef visible)
If MyTag = "show" Then
visible = True
Else
If control.Tag Like MyTag Then
visible = True
Else
visible = False
End If
End If
End Sub
'This is a custom sub that invalidates the ribbon as needed.
'When invalidated it has to redraw itself
Sub RefreshRibbon(Tag As String)
MyTag = Tag
If theRibbon Is Nothing Then
MsgBox "Error, Save/Restart your presentation"
Else
theRibbon.Invalidate
End If
End Sub
In a module named 'Events'
'Define the new events class
Dim cPPTEvent As New clsEvents
Sub Auto_Open()
'Enable the events when the aad-in is loaded
Set cPPTEvent.PPTEvent = Application
End Sub
Sub Auto_Close()
'Disable when it is closed
Set cPPTEvent.PPTEvent = Nothing
Set cPPTEvent = Nothing
End Sub
In a class module named 'clsEvents'. This will check the shapes in the range and if any are of the movie media type the tab will be shown on the ribbon, otherwise it'll be hidden.
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
Dim ppCurShape As PowerPoint.Shape
If Sel.Type = ppSelectionNone Then
RefreshRibbon ""
Exit Sub
End If
For Each ppCurShape In Sel.ShapeRange
If ppCurShape.Type = msoMedia Then
If ppCurShape.MediaType = ppMediaTypeMovie Then
RefreshRibbon "show"
Exit Sub
End If
End If
Next
RefreshRibbon ""
End Sub
And of course the ribbon XML code (taken from the first reference down the bottom)
<customUI onLoad="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon>
<tabs>
<tab id="MyCustomTab" label="My Tab" insertAfterMso="TabHome" getVisible="GetVisible" tag="MyPersonalTab" >
<group id="customGroup1" label="Group 1">
<button id="customButton1" label="Caption 1" size="normal" onAction="Macro1" imageMso="DirectRepliesTo" />
<button id="customButton2" label="Caption 2" size="normal" onAction="Macro2" imageMso="AccountMenu" />
<button id="customButton3" label="Caption 3" size="normal" onAction="Macro3" imageMso="RegionLayoutMenu" />
</group>
<group id="customGroup2" label="Group 2">
<button id="customButton4" label="Caption 4" size="normal" onAction="Macro4" imageMso="TextAlignGallery" />
<button id="customButton5" label="Caption 5" size="normal" onAction="Macro5" imageMso="PrintPreviewClose" />
<button id="customButton6" label="Caption 6" size="normal" onAction="Macro6" imageMso="PrintPreviewShrinkOnePage" />
<separator id="MySeparator1" />
<button id="customButton7" label="Caption 7" size="large" onAction="Macro7" imageMso="ReviewPreviousComment" />
</group>
<group id="customGroup3" label="Group 3">
<menu id="MyDropdownMenu" label="My Menu" size="large" imageMso="TextAlignGallery" >
<button id="customButton8" label="Caption 8" onAction="Macro8" imageMso="TextAlignGallery" />
<button id="customButton9" label="Caption 9" onAction="Macro9" imageMso="TextAlignGallery" />
<button id="customButton10" label="Caption 10" onAction="Macro10" imageMso="TextAlignGallery" />
<button id="customButton11" label="Caption 11" onAction="Macro11" imageMso="TextAlignGallery" />
<button id="customButton12" label="Caption 12" onAction="Macro12" imageMso="TextAlignGallery" />
</menu>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
For more reading:
Hiding the tabs and controls: http://msdn.microsoft.com/en-us/library/ee390805%28v=office.11%29#odc_office2007_DisplayHideRibbonControls_ChangingVisibilityRibbonTabs
Powerpoint events (thanks Steve): http://www.pptfaq.com/FAQ00004_Make_your_VBA_code_in_PowerPoint_respond_to_events.htm
List of events you can capture: http://officeone.mvps.org/vba/events_version.html

Customizing the PowerPoint Ribbon at Run-Time

I am developing a PowerPoint add-in and would like to temporarily disable some of the Ribbon controls while the add-in application is running.
I have developed a solution that works as expected when the Add-In is enabled, but this is not really adequate, because it disables some commonly used controls, like SlideMaster, SlideSorter, etc.
I am using PowerPoint 2010.
Here is a sample XML which is well-formed:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon startFromScratch="false">
<tabs>
<tab idMso="TabView">
<group idMso="GroupMasterViews" getVisible="GetVisible"/>
</tab>
</tabs>
</ribbon>
</customUI>
Here is a sample callback, taken from this SO answer:
Sub GetVisible(control As IRibbonControl, ByRef returnedVal As Boolean)
If TrapFlag Then
returnedVal = False ' control is hidden
Else:
returnedVal = True ' control is not hidden
End If
End Sub
When I navigate to the View ribbon, an alert informs me that:
The macro cannot be found or has been disabled because of your security settings.
Presumably this is referring to the GetVisible macro? My macro settings are:
Enable all macros (not recommended)
Trust access to the VBA project object model
I have been struggling with what I have found so far but so far unable to implement suggestions. Most answers are specific to Excel. I have not really found anything specific to PowerPoint, but figured it should not be terribly difficult to port code from one application to another, as I have done this for many other things in VBA.
I have also tried this method, but the SetCustomUI is not available in PowerPoint at the Application or Presentation level, perhaps it is unique or only applicable to Visual Studio?
After quite a bit of trial & error, I believe I have a functional solution, although there are some things I am not certain about which I will describe below.
I have tested this in a PPTM file with a subroutine to control the public TrapFlag variable, which determines whether to hide/disable certain controls. I have also tested this in a PPAM where this flag is set when the application launches, not when the Add-In is loaded.
This allows me to manipulate the RibbonUI at runtime.
Here is the XML:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>`
<customUI onLoad="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<commands>
<command idMso="ViewSlideSorterView" getEnabled="EnableControl"/>
<command idMso="ViewNotesPageView" getEnabled="EnableControl"/>
<command idMso="ViewSlideShowReadingView" getEnabled="EnableControl"/>
<command idMso="ViewSlideMasterView" getEnabled="EnableControl"/>
<command idMso="ViewHandoutMasterView" getEnabled="EnableControl"/>
<command idMso="ViewNotesMasterView" getEnabled="EnableControl"/>
<command idMso="WindowNew" getEnabled="EnableControl"/>
</commands>
<ribbon startFromScratch="false">
<tabs>
<tab idMso="TabView">
<group idMso="GroupMasterViews" getVisible="VisibleGroup"/>
<group idMso="GroupPresentationViews" getVisible="VisibleGroup"/>
</tab>
</tabs>
</ribbon>
Here is the VBA callbacks, generated from the CustomUI Editor application, modified as per my requirements.
Option Explicit
Public TrapFlag As Boolean
Public Rib As IRibbonUI
Public xmlID As String
Public Sub SetFlag()
Dim mbResult As Integer
mbResult = MsgBox("Do you want to disable some controls on the Ribbon?", vbYesNo)
If mbResult = vbYes Then
TrapFlag = True
Else:
TrapFlag = False
End If
End Sub
'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
'MsgBox "onLoad"
Set Rib = ribbon
End Sub
'I use this Callback for disabling some Controls:
' ViewSlideSorterView
' ViewNotesPageView
' ViewSlideShowReadingView
' ViewSlideMasterView
' ViewHandoutMasterView
' ViewNotesMasterView
' WindowNew
Sub EnableControl(control As IRibbonControl, ByRef returnedVal)
returnedVal = Not TrapFlag 'TrapFlag = True indicates the Application is running.
'MsgBox ("GetEnabled for " & control.Id)
'Debug.Print control.Id & " enabled = " & CStr(returnedVal)
Call RefreshRibbon(control.Id)
End Sub
'I use this Callback for disabling/hiding some tab groups:
' GroupMasterViews
' GroupPresentationViews
Sub VisibleGroup(control As IRibbonControl, ByRef returnedVal)
returnedVal = Not TrapFlag 'TrapFlag = True indicates the Application is running.
'MsgBox "GetVisible for " & control.Id
'Debug.Print control.Id & " enabled = " & CStr(returnedVal)
Call RefreshRibbon(control.Id)
End Sub
Sub RefreshRibbon(Id As String)
xmlID = Id
'MsgBox "Refreshing ribbon for " & Id, vbInformation
If Rib Is Nothing Then
MsgBox "Error, Save/Restart your Presentation"
Else
Rib.Invalidate
End If
End Sub
Some uncertainties
I am still not entirely sure what some Ron deBruin's code does (here), or whether it is necessary. I have done some testing and I do not really sure that the public variable xmlID is necessary in this case. He uses that somehow which I cannot understand.
Also, I am not able to use the same callback on the tab group as I
use on the command in the XML, so I use the tag getEnabled for
the commands, but I have to use getVisible for the groups. These
are tied to the callback functions EnableControl and
VisibleGroup, respectively. In any case, VisibleGroup seems to
disable the groups, so functionally it is the same.
I also believe that the getEnabled tag will prevent hotkey and programmatic access to those commands that I disable.