VBA Hacker

Button Popups: Create Your Own Popup Button Controls

By Romke Soldaat

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.

Finding Office Control IDs

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

Option Explicit

 

DefBool B

DefInt I

DefLng C, L

DefStr S

 

eclare 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

Declare Function StrToBuff Lib "kernel32" _

   Alias "lstrcpyA" (ByVal RetVal As String, _

   ByVal Ptr As Long) As Long

Declare Function strLen Lib "kernel32" Alias "lstrlenA" _

   (ByVal Ptr As Long) As Long

 

Public DefPrinter As String

Public NumPrinters As Long

 

'This routine puts a sorted list of installed printers in

' the strPrinters() array. For a quick query we use the

' PRINTER_INFO_5 data structure that retrieves the printer

' list from the registry.

Sub EnumeratePrinters(strPrinters())

  Dim bResult, bDefault, cbRequired, cbBuffer

  Dim lngBuffer(), lngFlags, lngEntries

  Dim i, strName

  Const PRINTER_ATTRIBUTE_DEFAULT = 4

  Const PRINTER_ENUM_LOCAL As Long = &H2

  Const PRINTER_ENUM_CONNECTIONS As Long = &H4

  lngFlags = PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL

  ' Test if 3072 is a large enough Buffer.

  cbBuffer = 3072

  ReDim lngBuffer((cbBuffer \ 4) - 1)

  bResult = EnumPrinters(lngFlags, vbNullString, 5, _

    lngBuffer(0), cbBuffer, cbRequired, lngEntries)

  ' If the Buffer was too small, cbRequired now tells us

  ' how large the Buffer must be.

  If bResult Then

     ' if cbBuffer wasn't large enough...

     If cbRequired > cbBuffer Then

       ' ...we have to increase the buffer size...

      cbBuffer = cbRequired

nbsp;      ReDim lngBuffer(cbBuffer \ 4)

       ' ...and call EnumPrinters again.

      bResult = EnumPrinters(lngFlags, vbNullString, 5, _

        lngBuffer(0), cbBuffer, cbRequired, lngEntries)

     End If

 

     ' lngEntries now holds the number of printers. The

    ' Buffer() array contains info about all printers. In

    ' this case we' re interested in the printer name and

    ' in the PRINTER_ATTRIBUTE_DEFAULT bit of the printer

    ' attributes.

     If lngEntries > 0 Then

      NumPrinters = lngEntries

       ReDim strPrinters(lngEntries - 1)

       For i = 0 To lngEntries - 1

         ' Initialize the buffer.

         ' 5 is here the number of items in PRINTER_INFO_5.

        strName = Space(strLen(lngBuffer(i * 5)))

         ' Copy buffer contents to strName string variable.

         Call StrToBuff(strName, lngBuffer(i * 5))

         ' See if this is the Windows default printer.

         If ((lngBuffer(i * 5 + 2) And _

            PRINTER_ATTRIBUTE_DEFAULT) = _

            PRINTER_ATTRIBUTE_DEFAULT) Then

          DefPrinter = strName

nbsp;        End If

         ' Add item to array.

        strPrinters(i) = strName

       Next

       ' Sort array.

      SelectionSort strPrinters()

     End If

  End If

End Sub

 

Sub SelectionSort(strArray())

  ' Generic sorting routine.

  Dim lngLower, lngUpper, lngCount1, lngCount2, _

      lngSmallest, strSmallest

  lngLower = LBound(strArray): lngUpper = UBound(strArray)

  For lngCount1 = lngLower To lngUpper - 1

    strSmallest = strArray(lngCount1)

    lngSmallest = lngCount1

     For lngCount2 = lngCount1 + 1 To lngUpper

       If StrComp(strArray(lngCount2), strSmallest, _

                 vbTextCompare) = -1 Then

        strSmallest = strArray(lngCount2)

        lngSmallest = lngCount2

       End If

     Next

     If lngSmallest <> lngCount1 Then

      strArray(lngSmallest) = strArray(lngCount1)

      strArray(lngCount1) = strSmallest

     End If

  Next

End Sub

End Listing Three

Copyright © 1999 Informant Communications Group. All Rights Reserved. • Site Use Agreement • Send feedback to the Webmaster • Important information about privacy