Of all the software packages I have on my computers, none is as customizable as Microsoft Office. And nobody will argue against the fact that Microsoft does a splendid job making all Office interface features available to programmers.
Did I say "all"? Okay, I was overstating; there are some controls that programmers are not allowed to touch. Most of them have been available since the launch of Office 95, and with each upgrade, I was silently hoping that Redmond would give us access to CommandBar controls beyond buttons, popups, edit boxes, and combo boxes. FIGURE 1 shows a variety of controls. Wouldn't it be wonderful if you could use the Gauge to create a zoom control, a Graphic Combo to create a list of your favorite fonts in their own typeface, or a Button Popup to display a menu at the click of a button?
FIGURE 1: Forbidden fruits of the Office Paradise. Clockwise
from top-left: Button Dropdown, Button Popup with tear-off toolbars,
Gauge, Graphic Combo.
Well, you can't. But in the case of Button Popups, there's a way to create a perfect look-alike. That's what we'll do in this installment of VBA Hacker.
What's a Button Popup?
A Button Popup control is a commandbar button that, when you click it, displays either a standard popup menu, or a graphical popup menu. FIGURE 2 shows an example of both. As you can see in the first picture, a Button Popup control looks very much like a standard button with a standard popup menu below it. Most likely, that's how the control is created by Office. Because all features of commandbar buttons and popup menus are available to VBA programmers, it's not difficult to mimic the behavior of a Button Popup. All you have to do is display a popup menu just below a button when that button is clicked. Let's see how we can achieve this, by creating Button Popup controls for the New, Open, Save, and Print buttons on the Standard toolbar.
FIGURE 2: A Button Popup control can display two
types of menus. On the left is a standard popup menu; on the right is a
graphical popup menu.
In Office 95 and 97, modifying the behavior of a standard commandbar button could be done in only one way: by setting an OnAction property for the button. The following instruction tells an Office application to run the AlternativeSave macro when the Save button on the Standard toolbar is clicked:
CommandBars("Standard").Controls("Save").OnAction =
_
"AlternativeSave"
To restore the default behavior, use the following instruction:
CommandBars("Standard").Controls("Save").Reset
In Office 2000, you can still use the same method, but there's a more exciting alternative: CommandBar control events. I touched on this feature in previous articles, but this time I'll dig a bit deeper.
CommandBar Events
When a user clicks a built-in CommandBar control, he or she triggers an event to which the parent application responds. As a programmer, you can intercept that event by writing your own event procedure. Once you've done that, your procedure runs instead of the standard procedure each time the associated CommandBar control is accessed. Office 2000 lets you write event procedures for two types of commandbar objects: buttons and combo boxes. In addition, you can write event procedures for the entire CommandBars collection. In this project, I limit myself to commandbar button objects; I'll tackle the other objects in a future article.
The Click event. Each commandbar button triggers a Clickevent when the user clicks it. It takes a number of steps to write an application that intercepts this event. First, you have to insert a class module into your project, which you can do from the File menu in the VB Editor. In our example, we name the module ControlTracker. In the class module, you declare an object variable using the WithEvents keyword. The following is an example:
PublicWithEventscmdSave As
Office.CommandBarButton
Here, we create an object variable named cmdSave, representing an Office CommandBarButton object. Once you've done this, the cmdSave object is listed in the Object box. Selecting the object in the list shows the available events in the Procedure box (see FIGURE 3).
FIGURE 3: The Objects and Procedures lists in the VB Editor.
When you select the Click event (which is the only option in the list), the head and tail of the procedure are automatically inserted in the module, including an empty line where you can start writing your event procedure. FIGURE 4 shows what that looks like.
Private Sub cmdSave_Click( _
ByVal Ctrl As Office.CommandBarButton,
_
CancelDefault As Boolean)
End Sub
FIGURE 4: Skeleton of the Click event procedure for the cmdSave button object.
We'll skip the contents of the event procedure for a minute, and continue to finish the preparation work. The final two steps are to tell the parent application that we want to create an instance of the ControlTracker class, and link the control's event to a specific CommandBar control (in our example the Save button on the Standard toolbar). Insert a standard module in your project, and add the following code:
Dim Tracker
As New
ControlTracker
Public Sub StartEventTracking()
Set Tracker.cmdSave = CommandBars.FindControl(ID:=3)
End Sub
The first line declares a Tracker variable pointing to the object in the ControlTracker class module. The New keyword tells VBA to create a new instance of the object the first time it's referenced, which happens in the StartEventTracking routine, shown in Listing One. Once you've executed this procedure, the cmdSave object in the class module points to the Save button (which has ID number 3; see the sidebar "Finding Office Control IDs" for more about CommandBar control IDs), and the button's Click event procedure will execute each time the user clicks that button. You can cancel the event handling routines by deleting the cmdSave object. The following instruction restores the original behavior of the Save button:
Set
Tracker.cmdSave = Nothing
Writing the Procedure that Creates a Button Popup
Now that we have everything in place, let's see how to create a popup menu that is displayed immediately below the Save button. What we want to do is fill a popup menu with commands that are related to the Save command. These commands differ from one Office application to another, but the following are common in Word, Excel, and PowerPoint:
Creating and displaying a popup menu is fairly simple. The macro in FIGURE 5 creates a blank popup menu, and adds the three items listed previously. The ShowPopup method displays the menu, and the Delete method destroys the menu when a choice has been made, or if the user clicks outside the menu.
Sub
ShowSavePopup
Dim myPop As CommandBar
Set myPop = CommandBars.Add(Position:=msoBarPopup)
myPop.Controls.Add
ID:=3 '
Save
myPop.Controls.Add
ID:=748 ' Save As...
myPop.Controls.Add
ID:=3823 ' Save as Web Page...
myPop.ShowPopup
myPop.Delete
End Sub
FIGURE 5: Macro to display a popup menu with options related to the Save command.
That's all the basics you need to know. Let's see how to implement this in our event procedure. As you can see in FIGURE 4, the Click event procedure comes with two arguments: The Ctrl argument points to the button that generates the event, and the CancelDefault argument is a Boolean that can be set to True or False.
By setting CancelDefault to True, we tell VBA that we want to ignore the default action, and take matters in our own hands. If you leave or set CancelDefault to its False value, the default event takes place, but you can still add extra instructions that you want to run in addition to the standard event.
Positioning the menu. We'll need the Ctrl argument to solve two problems. First, if we execute the code in FIGURE 5 in response to a click on the Save button, the ShowPopup method displays the popup menu at the current cursor position, which can be anywhere on the surface of the button. That's the default behavior of the ShowPopup method if you don't specify at which coordinates the menu must be displayed.
To simulate a perfect Button Popup, we want to position the menu just below the button, and left-aligned with the left side of the button. Because Ctrl represents that button, we can look at all its properties, in particular the Top, Left, and Height properties, and use those to calculate the coordinates of the popup menu.
The listing in FIGURE 6 shows how it's done. The Left property of the commandbar button is used to specify the x coordinate of the menu. The Top and Height properties are added to calculate the y coordinate. (For cosmetic reasons, I subtract one from that value, which closes the one-pixel gap between the button and the menu.)
Private Sub cmdSave_Click( _
ByVal Ctrl As Office.CommandBarButton,
_
CancelDefault As Boolean)
On
Error Resume Next
If
Ctrl.Parent. Type = msoBarTypeNormal Then
CancelDefault =
True
Dim myPop As
CommandBar
Set myPop = CommandBars.Add(Position:=msoBarPopup)
With myPop
With .Controls
.Add
ID:=3 '
Save
.Add
ID:=748 ' Save As...
.Add
ID:=3823 ' Save as Web Page...
.Add
ID:=1713 ' Save Version...
.Add
ID:=749 ' Save All
.Add
ID:=3488 ' Add Document to
Favorites
.Add
ID:=2239 ' Save Template
.Add
ID:=2347 ' Tools Options
Save
End With
.ShowPopup Ctrl.Left,
Ctrl.Top + Ctrl.Height - 1
.Delete
End With
End
If
End Sub
FIGURE 6: Fool-proof version of a Click event procedure for the Save button in Word.
To pop or not to pop. The If statement in FIGURE 6 also demonstrates how a second problem is solved. Remember, we've modified the behavior of the Save command (with its ID number 3), but that command also appears on the File menu. Even though the Save button and the Save menu item look different, they are exactly the same. Because we don't want to change the behavior of the Save command when it's not on a toolbar, we need to find out where the event was generated.
That's where the Parentproperty of the button comes in. The Parent object identifies the commandbar that holds the button. This object has a number of properties, of which the Type property tells us what sort of commandbar it is. The value of the Type property can be msoBarTypeNormal (value 0), msoBarTypeMenuBar (1), or msoBarTypePopup (2). The listing in FIGURE 6 makes sure that the event procedure runs only if the button is clicked on a toolbar. If not, CancelDefault keeps its False value, and the original Save action is executed.
The final version of the event procedure, shown in Listing Two, looks a bit different, because it has to allow for the different Save options in Word, Excel, and PowerPoint, but the structure is identical to the one in FIGURE 6. You can see the results in FIGURE 7.
FIGURE 7: The perfect Button Popup look-alikes. From left to
right: implementations for Word, Excel, and PowerPoint.
Creating "New" and "Open" Button Popups
Based on what I've discussed so far, it shouldn't be complicated to create Button Popups for the New and Open buttons on the Standard toolbar. Listing Two shows how it's done. I've taken the opportunity to enhance these buttons further by adding a list of templates to the New button (see FIGURE 8), and a list of recent files to the Open button. These lists are created with the help of three additional objects: Application.FileSearch, Scripting.FileSystemObject, and Wscript.Shell (see end of article for more about these objects). The listing is extensively commented, so you can see what happens and why.
FIGURE 8: The New popup menu for Word, listing all
available templates.
Creating a "Print" Button Popup
The last challenge is to create a popup menu that replaces the default action for the Print button. Wouldn't it be nice to display a menu of all installed printers, so that you can instantly send the active document, workbook, or presentation to the printer of your choice? If VBA were the same as VB, that would be easy - VB6 has a Printers collection, which contains the names of all printers. Our friends in Redmond seem to believe that you don't need that in VBA, so we have to find the list of printers elsewhere.
There are several methods to obtain this list. The easiest way is to retrieve the printer names from the WIN.INI file, but Microsoft doesn't recommend this, and recommends you use the registry instead. Also, I'm not entirely sure if WIN.INI is always updated by the operating system, especially if a user is connected to a network printer. When I researched this article, I had a look inside Word's Fax Wizard, and found that Microsoft's programmers needed nearly two hundred lines of VBA code to extract the names of installed printers from the registry! Fortunately, I found a Knowledge Base article (Q166008, "Enumerating Local and Network Printers") that provides an example that requires a lot less code. Because that article originated from the days of Access 7, and catered to NT 3.51 (which isn't supported by Office 2000), I reworked and simplified the code to suit Windows 95/98 and Windows NT/2000. The entire routine now takes only 30 lines. You'll find it in the EnumeratePrinters routine in the GetPrinters.bas module, shown in Listing Three.
Using the API to enumerate printers. The routine uses the EnumPrintersAPI function, which walks through all available printers, print servers, domains, and print providers. The function takes no less than seven parameters. Here's the declaration:
Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" (ByVal lngFlags
As Long,
_
ByVal name As String, ByVal Level
As Long,
_
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, pcReturned
As Long) As Long
The most interesting one is the Level parameter (a Long value in the range 1 through 5), which tells the function to use one of the five Windows PRINTER_INFO_X data structures (where X stands for the specified Level number). Some of these structures provide up to twenty members, allowing you to obtain all sorts of exotic information about each printer, such as the average number of pages per minute that have been printed, and status details (paper jam, low toner, etc.). One structure is specifically designed to help programmers get a list of installed local and network printers. This structure (PRINTER_INFO_5) is not listed in the EnumeratePrinters routine, so I show it in FIGURE 9.
Public Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type
FIGURE 9: One of the five Printer Info structures. PRINTER_INFO_ 5 can be used for Windows 95/98 and NT/2000.
When the EnumPrinters API function uses the PRINTER_INFO_5 structure, it retrieves the information directly from the registry, rather than querying each printer. While the list is generated, the members of the structure are filled with the appropriate data. The first member contains the name of the printer, the second one the name of the port (for a local printer) or the server (for a remote printer), and the third member contains a numeric value representing printer attributes. The attribute used in the EnumeratePrinters routine is PRINTER_ATTRIBUTE_DEFAULT (numeric value 4), which, in Windows 95/98, indicates that the printer is the default printer in the system.
The last two PRINTER_INFO_5 members are not used with Windows NT/2000, so we ignore them.
Building the Printer menu. The bottom part of the Clickevent procedure for the cmdPrint button object (again, see Listing Two) looks mostly like the procedures I discussed previously. The top part may need some clarification. The following lines in the procedure obtain the printer list:
Dim
strPrn()As String
EnumeratePrinters strPrn()
This is the way to use the EnumeratePrinters routine in the GetPrinters.bas module. You dimension an empty string array, and use that as the parameter in your call to EnumeratePrinters. Upon return, the array is filled with a sorted list of all local and remote printers. At the same time, a public DefPrinter variable receives the name of the default system printer, and a public NumPrinters variable holds the number of printers. Then the buttons are created:
If NumPrinters
> 0 Then
For i = 0 To NumPrinters - 1
With ButtonPopup.Controls.Add
.Caption = strPrn(i)
.FaceId
= IIf(InStr(1, strPrn(i), _
"fax",
vbTextCompare), 1707, 4)
.State
= (strPrn(i) = DefPrinter)
.OnAction =
"PrintDocumentTo"
End With
Next
End If
In these lines, the FaceID property of each button depends on the name of the printer. If the name holds the substring "fax" (the vbTextCompare parameter of the Instr function covers all lowercase and uppercase variations), the icon becomes the same as the Send to Fax Recipient command (ID 1707); otherwise the icon of the Print command (ID 4) is chosen.
To give the button for the default system printer a "selected" look, the name of the printer is compared with the value of the DefPrinter variable. If both strings are the same, the button's State property is set to True (-1), which happens to be the same value as the msoButtonDown constant. FIGURE 10 shows the result.
FIGURE 10: The Print popup menu for Word.
Sending a document to a specific printer. If the developers of the different Office applications were on speaking terms, there would be a lot more consistency across the suite. Take, for example, the ActivePrinterproperty of the Application object. It's available in Word, Excel, and PowerPoint, but the implementation differs quite a bit. If your printer is an HP DeskJet and you write a line like:
AppPrinter =
Application.ActivePrinter
AppPrinter will hold the string "HP DeskJet" in Excel and PowerPoint, but in Word, you get something like "HP DeskJet on LPT1:". That's an annoying difference, especially if you want to work with that string in different languages (in French, you would get "HP DeskJet sur LPT1:").
And it gets worse. In Word and Excel, you can use the following instruction to set the active printer:
Application.ActivePrinter = "HP DeskJet"
Now, try this in PowerPoint. What do you get? "Compile error. Can't assign to read-only property." If anyone can tell me why the ActivePrinter property is a read/write string in Word and Excel, but read-only in PowerPoint, I'd love to hear it.
If this inconsistency didn't exist, I could have used the following application-independent code to print a document, worksheet, or presentation to a specific printer:
CurPrinter =
Application.ActivePrinter
Application.ActivePrinter = "HP DeskJet"
ActiveWindow.Parent.PrintOut
Application.ActivePrinter =
CurPrinter
Because this will fail in PowerPoint, I decided to create three small application-specific modules that deal with the code to print the active file in Word, Excel, and PowerPoint. The same modules also contain the code to create a new file, or open an existing file in each application. Due to space restrictions, you won't find these modules in the listing, but they are included in the download file (see end of article for details).
Bypassing the Popups
Finally, I've included one line of macro code in each event procedure that lets you run the default command rather than display the popup menu. This is controlled with the instruction:
If CtrlKeyDown
Then Exit Sub
CtrlKeyDown is a property in the ControlTracker class that looks at the state of the [Ctrl] key. The property procedure calls the Windows GetKeyState function, using the VK_CONTROL parameter. If this function returns a value smaller than zero, it sets the property to True, in which case the event procedure from which the property is read doesn't run. This allows you to skip the popup menu, and instantly save or print the active document, create a new blank document, or display the Open dialog box.
Creating the ButtonPopup add-ins. The accompanying download file (see end of article for details) contains all the modules you need to create the ButtonPopup add-ins for Word, Excel, and PowerPoint 2000. A README.TXT file gives step-by-step instructions.
Conclusion
The purpose of this series is to demonstrate that there's a lot more to VBA programming than you may think. With a bit of hacking, you can create powerful new tools to enhance your Office environment. In this article, I demonstrated that you can build your own ButtonPopup controls, adding a host of new features to standard commandbar buttons. Watch this space for more VBA hacks!
The modules in the download file make references to three objects:
The VBA source referenced in this article is available for download.
Dutchman Romke Soldaat was hired by Microsoft in 1988 to co-found the Microsoft International Product Group in Dublin, Ireland. That same year he started working with the prototypes of WinWord, writing his first macros long before the rest of the world. In 1992 he left Microsoft, and created a number of successful add-ons for Office. Currently living in Italy, he divides his time between writing articles for this magazine, enjoying the Mediterranean climate, and steering his Landrover through the world's most deserted areas. Romke can be contacted at mailto:rsoldaat@hotmail.com.
One of the great benefits of the Office package is that the different applications (Word, Excel, and PowerPoint) share a common interface. The menu bars are nearly identical, and where commands on menus and toolbars in different applications have similar functions, they display identical button images and captions.
Because each control in the Office interface has a unique numeric identifier, you can find any control (and its associated properties) by looking for its ID. Don't dig into your VBA documentation for anything worthwhile about control IDs, though. The only references you'll find is under the description of the Add and FindControl methods for CommandBar controls:
expression.Add(Type, Id, Parameter,
Before, Temporary)
expression.FindControl(Type, Id,
Tag, Visible, Recursive)
In this syntax, Id must be an integer that specifies the identifier of a built-in control. What the documentation doesn't say is that this value is the same as the value you get if you evaluate the FaceId property of a built-in commandbar button. For example, the FaceId value of the New button of the Standard toolbar is 2520; hence, the ID of the control itself is also 2520. In other words, if you need an ID value for the Add and FindControl methods, but you don't know which value is associated with a built-in control, you can use its FaceId property.
The Office documentation doesn't provide a list of the IDs of all commands. If you want to know the IDs of a limited number of controls, consider creating a temporary toolbar, and dragging the command buttons onto it via the Customize dialog box. Then run the following macro:
Private Sub ShowCommandIDs()
On
Error Resume Next
Dim
ctl As CommandBarControl
For
Each ctl In
CommandBars("Temp").Controls
ctl.Style =
msoButtonIconAndCaption
Debug.Print ctl.ID,
ctl.Caption
Next
End Sub
This lists the IDs and captions of the commands in the VBE Immediate window. One thing you'll notice is that even controls that have no icon at all still have a FaceId property!
Using this method, I created a list of all IDs that I could use in the popup menus for the New, Open, Save and Print buttons. Some controls are not valid in all applications, but an On Error Resume Next statement in the event procedures makes sure that invalid controls are simply ignored. FIGURE A lists the IDs used in the routines of this project.
New button (Control/FaceID 2520) | ||
Control/FaceID |
Caption |
Valid in: |
2520 |
New (default document) |
All |
3794 |
New Web Page |
Word |
3795 |
New E-mail Message |
Word |
18 |
New... (pick from dialog) |
All |
Open button (Control/FaceID 23) | ||
Control/FaceID |
Caption |
Valid in: |
23 |
Open... |
All |
1021 |
Open Favorites... |
All |
1015 |
Open... (Internet address) |
All |
Save button (Control/FaceID 3) | ||
Control/FaceID |
Caption |
Valid in: |
3 |
Save |
All |
748 |
Save As... |
All |
3823 |
Save as Web Page... |
All |
3903 |
Publish as Web Page... |
Excel, PowerPoint |
1713 |
Save Version... |
Word |
749 |
Save All |
Word |
3488 |
Add Document to Favorites |
Word |
2239 |
Save Template |
Word |
2347 |
Tools Options Save |
Word |
846 |
Save Workspace... |
Excel |
2695 |
Pack and Go |
PowerPoint |
Print button (Control/FaceID 2521) | ||
Control/FaceID |
Caption |
Valid in: |
4 |
Print... (from dialog) |
All |
1707 |
Sent To Fax Recipient |
Word |
109 |
Print Preview |
Word, Excel |
511 |
Print Setup... |
Word |
364 |
Set Print Area |
Excel |
1584 |
Clear Print Area |
Excel |
FIGURE A: Control IDs used in this project.
Begin Listing One - DropButtons.bas
' Create object at
first call.
Dim Tracker
As New
ControlTracker
Public Sub StartEventTracking()
On
Error Resume Next
With Tracker
Set .cmdNew = CommandBars.FindControl(ID:=2520)
Set .cmdSave = CommandBars.FindControl(ID:=3)
Set .cmdOpen = CommandBars.FindControl(ID:=23)
Set .cmdPrint = CommandBars.FindControl(ID:=2521)
End
With
End Sub
Public Sub StopEventTracking()
On
Error Resume Next
With Tracker
Set .cmdNew = Nothing
Set .cmdSave = Nothing
Set .cmdOpen = Nothing
Set .cmdPrint = Nothing
End
With
End Sub
End Listing One
Begin Listing Two - ControlTracker.cls
Option Explicit
DefInt C,
I
DefStr
S
' WithEvents
declarations to create
' objects that must
respond to events.
Public WithEvents cmdNew As
Office.CommandBarButton
Public WithEvents cmdOpen As
Office.CommandBarButton
Public WithEvents cmdSave As
Office.CommandBarButton
Public WithEvents cmdPrint As
Office.CommandBarButton
' Object variables.
Dim FSO As Object
Dim WSH As Object
Dim FS As FileSearch
Dim ButtonPopup
As CommandBar
' Identifies parent
application.
Dim AppID As Integer
' Registry section.
Const
REG_GENERALDATA = _
"HKCU\Software\Microsoft\Office\9.0\Common\General\"
' Function to track
up/down state of keyboard keys.
Private Declare Function
GetKeyState Lib "user32" ( _
ByVal vKey As Long) As Integer
' This routine runs
when the class is first initialized.
Private Sub Class_Initialize()
On
Error Resume Next
' Create
object variables.
Set
FSO = CreateObject("Scripting.FileSystemObject")
Set
WSH = CreateObject("Wscript.Shell")
Set
FS = Application.FileSearch
' Create
IDs for each Application.
Select Case
Application.name
Case "Microsoft
Word": AppID = 1
Case "Microsoft
Excel": AppID = 2
Case "Microsoft PowerPoint":
AppID = 3
Case Else:
End Select
End Sub
' The following event
procedures are executed when the
' associated buttons
are clicked. In each case, the status
' of the Ctrl key is
first evaluated. If the key is down,
' the event procedure
is cancelled, and the default command
' is executed. After
that, the procedure checks to see
' *where* the button is
clicked. If the button isn't on a
' toolbar, but on a
menu or popup control, the default
' command is executed.
The On Error Resume Next statement
' is used to cancel
error messages in case a button is
' added which is not
valid in the parent application.
Private Sub cmdNew_Click( _
ByVal Ctrl As Office.CommandBarButton,
_
CancelDefault As Boolean)
On
Error Resume Next
If
CtrlKeyDown Then Exit Sub
If
Ctrl.Parent. Type = msoBarTypeNormal Then
CancelDefault =
True
Dim i, Count
Set ButtonPopup =
CommandBars.Add(Position:=msoBarPopup)
With ButtonPopup
With .Controls
.Add
ID:=2520 ' New Blank Document.
.Add
ID:=3794 ' New Web Page.
.Add ID:=3795
' New E-mail Message.
.Add
ID:=18 ' New...
End With
Count =
.Controls.Count
With FS
.NewSearch
' Use template extensions for parent application.
.FileName =
_
Choose(AppID,
"*.dot;*.wiz", "*.xlt", "*.pot")
.LookIn =
UserTemplatesFolder & ";" & _
SharedTemplatesFolder
.SearchSubFolders
= True
If .Execute Then
For i = 1 To
.FoundFiles.Count
With ButtonPopup.Controls.Add()
' Use filename for caption.
.Caption
= FSO.GetBaseName(FS.FoundFiles(i))
' Use full pathname as parameter.
.Parameter
= FS.FoundFiles(i)
' Use the application's icon.
.FaceId
= Choose(AppID, 42, 263, 267)
.OnAction
= "NewFile"
' Hide temporary files.
.Visible
= (Left(.Caption, 1) <> "~")
End With
Next
End If
End With
.Controls(Count +
1).BeginGroup = True
.ShowPopup Ctrl.Left,
Ctrl.Top + Ctrl.Height - 1
.Delete
End With
End
If
End Sub
Private Sub cmdOpen_Click( _
ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
On
Error Resume Next
If
CtrlKeyDown Then Exit Sub
If
Ctrl.Parent. Type = msoBarTypeNormal Then
CancelDefault =
True
Dim i
nbsp; Set ButtonPopup =
CommandBars.Add(Position:=msoBarPopup)
With ButtonPopup
With .Controls
.Add
ID:=23 ' Open...
.Add
ID:=1021 ' Open Favorites...
With .Add(ID:=1015) ' Open... (Internet)
.Caption
= .Caption & " (Internet)"
End With
With FS
.NewSearch
' Find files for associated application.
.FileType
= Choose(AppID, _
msoFileTypeWordDocuments,
_
msoFileTypeExcelWorkbooks,
_
msoFileTypePowerPointPresentations)
.LookIn
= HistoryFolder
If .Execute Then
For i = 1 To
.FoundFiles.Count
With ButtonPopup.Controls.Add()
nbsp; ' Use filename for caption.
.Caption
= _
FSO.GetFileName(FS.FoundFiles(i))
' Use full pathname as parameter.
.Parameter
= FS.FoundFiles(i)
' Use the application's icon.
.FaceId
= Choose(AppID, 42, 263, 267)
.OnAction
= "OpenFile"
.BeginGroup
= (i = 1)
End With
Next
End If
End With
End With
.ShowPopup Ctrl.Left,
Ctrl.Top + Ctrl.Height - 1
.Delete
End With
End
If
End Sub
Private Sub cmdPrint_Click( _
ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
On
Error Resume Next
If
CtrlKeyDown Then Exit Sub
If
Windows.Count = 0 Then Exit Sub
If
Ctrl.Parent. Type = msoBarTypeNormal Then
CancelDefault =
True
Set ButtonPopup =
CommandBars.Add(Position:=msoBarPopup)
Dim strPrn(), i
EnumeratePrinters
strPrn()
nbsp; ' NumPrinters is a global variable.
If NumPrinters > 0 Then
For i = 0 To
NumPrinters - 1
With ButtonPopup.Controls.Add
.Caption
= strPrn(i)
.FaceId
= IIf(InStr(1, strPrn(i), "fax", _
vbTextCompare),
1707, 4)
' DefPrinter is a global variable.
nbsp; .State
= (strPrn(i) = DefPrinter)
.OnAction
= "PrintDocumentTo"
End With
Next
End If
With ButtonPopup
With .Controls
With
.Add(ID:=4)
' Print...
.BeginGroup
= True
End With
With
.Add(ID:=1707) ' Fax Recipient.
.Caption
= .TooltipText ' Add "Send to".
End With
.Add
ID:=109 ' Print Preview.
.Add
ID:=511 ' Print Setup...
With
.Add(ID:=364) ' Set Print Area.
.BeginGroup
= True
End With
.Add
ID:=1584 ' Clear Print Area.
End With
.ShowPopup Ctrl.Left,
Ctrl.Top + Ctrl.Height - 1
.Delete
End With
End
If
End Sub
Private Sub cmdSave_Click( _
ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
On
Error Resume Next
If
CtrlKeyDown Then Exit Sub
nbsp; If
Windows.Count = 0 Then Exit Sub
If
Ctrl.Parent. Type = msoBarTypeNormal Then
CancelDefault =
True
Set ButtonPopup = _
CommandBars.Add(Position:=msoBarPopup)
With ButtonPopup
With .Controls
.Add
ID:=3 ' Save.
.Add
ID:=748 ' Save As...
.Add
ID:=3823 ' Save as Web Page...
.Add
ID:=3903 ' Publish as Web Page...
.Add
ID:=1713 ' Save Version...
.Add
ID:=749 ' Save All.
With .Add(ID:=3488) ' Add Document to Favorites.
.BeginGroup
= True
End With
.Add
ID:=2239 ' Save Template.
.Add
ID:=2347 ' Tools Options Save.
.Add
ID:=846 ' Save Workspace.
nbsp; .Add
ID:=2695 ' Pack and Go.
End With
.Controls(.Controls.Count).BeginGroup
= True
.ShowPopup Ctrl.Left,
Ctrl.Top + Ctrl.Height - 1
.Delete
End With
End
If
End Sub
' The following
routines use the Windows Scripting Host
' to access the Windows
registry.
Property Get UserTemplatesFolder()As String
On
Error Resume Next
UserTemplatesFolder =
WSH.RegRead(REG_GENERALDATA & _
"UserTemplates")
End Property
Property Get SharedTemplatesFolder()As String
On
Error Resume Next
SharedTemplatesFolder =
WSH.RegRead(REG_GENERALDATA & _
"SharedTemplates")
End Property
Property Get HistoryFolder()As
String
On
Error Resume Next
HistoryFolder =
FSO.GetSpecialFolder(0) & "\" & _
WSH.RegRead(REG_GENERALDATA &
"ApplicationData") & _
"\Microsoft\Office\" & _
WSH.RegRead(REG_GENERALDATA &
"RecentFiles")
End Property
Property Get CtrlKeyDown()As
Boolean
' Get the
up/down state of the Control key.
Const VK_CONTROL = &H11
CtrlKeyDown =
(GetKeyState(VK_CONTROL) < 0)
End Property
End Listing Two
Begin Listing Three -
GetPrinters.bas
End Listing Three
Copyright © 1999 Informant Communications Group. All Rights Reserved. • Site Use Agreement • Send feedback to the Webmaster • Important information about privacy