http://www.microsoft.com/TechNet/desk/office/excel/prodfact/xlvbsamp.htm (PC Press Internet CD, 03/1996)
Posted/Update Date:May 18. 1995
Written by Tonya Wishart
ABSTRACT: Five Visual Basic, Applications Edition macros are included, along with examples and step-by-step explanations. You can use them in Microsoft Excel 5.0 to:
Create a Masked Password Dialog Box
Set Status Bar Text and ToolTips for Toolbar Buttons
Work with Data in a Custom Dialog Box
Use SQLExecQuery or SQLRequest with Large Query
Save Files to Microsoft Excel 4.0 Format by Default
The article assumes that you are familiar with the Visual Basic macro language. A line preceded by an apostrophe ( ' ) introduces a comment in the code to explain what the code is doing at that point in the procedure. An underscore character ( _ ) indicates that code continues from one line to the next; you can type lines that contain this character as one logical line or divide them and use the line continuation character. For more information about Visual Basic for Applications programming style, see the "Programming Style in This Manual" section in the "Document Conventions" section of the Visual Basic User's Guide .
Microsoft provides these examples for illustration only, without warranty either expressed or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. Visual Basic procedures are provided 'as is' and Microsoft does not guarantee that they can be used in all situations. Microsoft does not support modifications of these procedures to suit customer requirements for a particular purpose.
In Microsoft Excel, custom dialog boxes you create to prompt a user for information using text boxes, buttons, or other dialog box controls normally display text as you type it in. If you want to create a password dialog box that does not show the text as it is entered, you can use a Visual Basic, Applications Edition procedure to create the effect of a hidden, or "masked," edit box. The following instructions describe how to create this effect.
To "mask" an edit box, you basically create two edit boxes, one that's visible and one that's hidden. When the user enters the password in the hidden edit box, a Visual Basic procedure enters "masking" characters in the visible edit box.
Follow this procedure:
Create a dialog sheet with a dialog frame that has an OK button, a Cancel button, and two edit boxes (of the same size) as shown in Figure 1.
Figure 1 Dialog caption box
Drag one of the edit boxes off of the dialog frame on the dialog sheet. Select this edit box. In the Name box, type EditHidden and press ENTER.
Position the second edit box on the dialog frame where you want the password to be entered.
On the dialog frame, select the second edit box. In the Name box, type EditShown and press ENTER.
From the Tools menu, choose Tab Order. From the Tab Order list, select EditHidden. Click the button until EditHidden is at the top of the Tab Order list. Choose OK.
From the Insert menu, choose Macro, and then choose Module to insert a new module sheet. In the new module, enter:
' Dimension variable as public
Public CancelFlag As Boolean
Sub Main()
' Dimension variables
Dim password As String
' Set initial conditions
CancelFlag = False
DialogSheets(1).EditBoxes("EditHidden").Text = ""
' Loop while password is incorrect and cancel button not pressed
While password <> "hello" And CancelFlag = False
' Set conditions for dialog box display
DialogSheets(1).EditBoxes("EditShown").Text = ""
DialogSheets(1).EditBoxes("EditShown").Enabled = False
' Display the dialog box
DialogSheets(1).Show
password = DialogSheets(1).EditBoxes("EditHidden").Text
' Continue loop until correct password is entered
Wend
' Check to see if the Cancel button is chosen
If CancelFlag = False Then
' If loop has ended and Cancel button has not been pressed,
' then password is correct
MsgBox "Correct password entered"
Else
MsgBox "Dialog was canceled"
End If
End Sub
' Procedure assigned to EditHidden Edit box
Sub PasswordMask()
' Dimension variables
Dim MaskString As String, i As Integer
MaskString = ""
' Match mask string length to length of text entered
For i = 1 To Len(DialogSheets(1).EditBoxes("EditHidden").Text)
MaskString = MaskString & "*"
Next i
' Enter mask string in EditShown Edit box
DialogSheets(1).EditBoxes("EditShown").Text = MaskString
End Sub
' Macro assigned to the Cancel button
Sub Canceled()
' Cancel chosen, set CancelFlag value to True
CancelFlag = True
End Sub
Select the dialog sheet tab to active the sheet that contains your dialog box. On the dialog sheet, select the EditHidden edit box, and choose Assign Macro from the Tools menu. From the Macro Name/Reference list, select PasswordMask and choose OK.
On the dialog box, select the Cancel button, and choose Assign Macro from the Tools menu. From the Macro Name/Reference list, select Canceled and choose OK.
From the Tools menu, choose Macro. From the Macro Name/Reference list, select Main and choose Run.
The dialog box that you created is displayed. As you type your password it is entered in the hidden edit box outside the dialog frame. The asterisk character (*) is displayed for each character you type in the visible edit box within the dialog frame.
The dialog box is displayed until you enter the correct password or until you choose the Cancel button.
In Microsoft Excel version 5.0, status bar text associated with a toolbar button behaves differently than in earlier versions of Microsoft Excel: you can assign status bar text to a toolbar button by using a Visual Basic procedure, or by using the Status Bar Text box in the Macro Options dialog box.
Note To display the Macro Options dialog box, choose Macro from the Tools menu, select the name of the macro assigned to the toolbar button, and choose the Options button.
The text displayed on the status bar when you choose a button from a toolbar is a property of the macro assigned to the button, not a property of the button itself. When you assign a macro to a toolbar button, the status bar text for that macro is assigned to the corresponding toolbar button and is displayed when you position the mouse cursor over it.
The status bar text changes whenever a macro is assigned to a toolbar button. If you assign to a toolbar button a macro that has no status bar text, the status bar displays the button's default text when you choose that button. For example, if you assign a macro to a button taken from the Custom category, and you do not add a Status Bar Text entry for this macro, the default text displayed on the status bar for this button is "Creates A Button To Which You Can Assign A Macro."
ToolTips, a new feature in Microsoft Excel version 5.0, can be assigned to a toolbar button only by using a macro. ToolTips are a property of the individual toolbar buttons. They change only when you use a Visual Basic macro to set the Name property for a particular toolbar button.
The Visual Basic macro example below:
Prompts you for the name of the custom toolbar you want to create.
Adds a button to this toolbar.
Prompts you for the ToolTip text you want for the button.
Assigns the sample macro "myMacro" to the new toolbar button.
Prompts you for the status bar text you want displayed for the new button.
Sub AddButton()
' Dimension variables
Dim mytoolbar As String, mytooltip As String, mystatbar As String
Dim used As Boolean, x As Integer
again:
' Set variable used to value False
used = False
' Prompt for name of new toolbar to create
mytoolbar = InputBox("Enter name of new toolbar to add:")
' Check for duplicate toolbar name
For x = 1 To Application.Toolbars.Count
If UCase(mytoolbar) = UCase(Application.Toolbars(x).Name) Then
' If same name exists, set variable used to value True
used = True
End If
Next
' If toolbar name exists, prompt for name again
If used = True Then
MsgBox "Sorry, this toolbar name is already being used." & _
" Please enter name of toolbar that doesn't already exist."
' Display original dialog asking for name
GoTo again
End If
' Check for blank toolbar name entered
If mytoolbar = "" Then GoTo none
' Create a new toolbar with the name entered above
With Toolbars.Add(mytoolbar)
' Show the newly created toolbar
.Visible = True
' Add the "hand" button to the new toolbar
' and assign macro "myMacro" to the new button
' Note that you can modify this line to add any button
' you want, and assign any existing macro
.ToolbarButtons.Add Button:=229, OnAction:="myMacro"
' Prompt for ToolTip to display for new button
mytooltip = _
InputBox("Enter text of ToolTip to display for new button:")
' Add ToolTip to new button with name entered above
.ToolbarButtons(.ToolbarButtons.Count).Name = mytooltip
End With
' Prompt for text to display on the status bar when you
' hold the mouse over this button.
mystatbar = InputBox("Enter text that you want to appear" & _
" on the status bar for this button")
' Assign status bar text entered above to macro "myMacro"
' that is assigned to the new button
Application.MacroOptions Macro:="myMacro", statusbar:=mystatbar
none:
End Sub
' Sample macro that is assigned to new button
Sub myMacro()
MsgBox "This is the macro that is assigned to your new toolbar button!!"
End Sub
Note The Toolbars(x).ToolbarButtons.Count command counts the buttons and any spaces between them. In the example above, the Toolbars(x).ToolbarButtons.Count command is not necessary, because the procedure creates a new toolbar and adds only one button. The command is shown here only to demonstrate how to return the number of buttons on a given toolbar.
You cannot use a Visual Basic macro to assign status bar text directly to a toolbar button, because status bar text can be assigned only to a macro. You can, however, effectively create status bar text for a button by assigning a macro to the button and assigning the status bar text to the macro. In the example above, the macro "myMacro" is automatically assigned to the newly created button to show how you can then add the statusbar text.
Note
The StatusBar argument of the MacroOptions method affects the status bar only when you position the cursor over a button or a menu command without selecting it. To display text on the status bar while a macro is running, you can use the StatusBar property as shown in this example:
Application.StatusBar="<text>"
where <text> is the text you want to appear on the status bar when you run the macro.
To return control of the status bar to Microsoft Excel after running the macro that contains the above statement, set the StatusBar property to FALSE. Use this command:Application.StatusBar=FALSE.
In Microsoft Excel, you can create a custom dialog box by inserting a dialog sheet in your workbook. Each dialog sheet contains a dialog frame, with OK and Cancel buttons by default. The Forms toolbar is automatically displayed, and you can choose from an assortment of buttons on this toolbar to add controls to the dialog frame.
You can use a Visual Basic macro to display the dialog box, determine which items in the dialog box are selected, and perform an action. The following examples show you how to work with data in a custom dialog box, including how to determine which items are selected in a multi-selection list box, how to link an edit box value to a worksheet cell, and how to display a different list in a dialog based on the selected option.
In a custom dialog box, a multi-selection list box allows you to choose any number of items from a list. For example, if a list contains Alpha, Bravo, and Charlie, you can select any, none, or all of them.
To determine which items are selected, you can use the list box's Selected property. For a multi-selection list box this is an array of values. Each value is either True (if the item is selected) or False (if the item is not selected). For example, if a list contains Alpha, Bravo, and Charlie, and Bravo and Charlie are selected, the Selected property returns an array that contains these values:
False, True, True
because the first item (Alpha) is not selected, but the second and third items (Bravo and Charlie) are.
The following example shows you how to read the Selected array for a multi-selection list box using a Visual Basic procedure.
In a new workbook, insert a new worksheet (Sheet1), a dialog sheet (Dialog1), and a Visual Basic module (Module1).
On the worksheet, enter the following values:
A1: Alpha
A2: Bravo
A3: Charlie
A4: Delta
A5: Echo
A6: Foxtrot
A7: Golf
A8: Hotel
Select the Dialog1 sheet tab to activate the dialog sheet. Follow the procedure below to add a multi-selection list box (List1) that is linked to the range $A$1:$A$8 on Sheet1.
From the Forms toolbar, choose the List Box button. Drag on the dialog frame to create a list box. Your dialog frame should appear similar to Figure 2 below.
Figure 2 Dialog frame
On the dialog frame, select the list box.
In the Name box, type List1 and press the ENTER key.
From the Format menu, choose Object.
In the Format Object dialog box, select the Control tab.
In the Input Range box, type Sheet1!$A$1:$A$8.
Under Selection Type, select the Multi option. Choose OK to accept the changes.
The list box is now linked to the range $A$1:$A$8 on Sheet1 and is a multi-selection list box.
Select the Module1 sheet tab, and enter:
Sub ShowSelectedItems()
' Dimension variables
Dim CurList As ListBox, chosen As Integer
Dim LTemp As Variant, LItem As Variant
Dim Counter As Integer, msgboxtext As String
' Set an object name for the list box to make it easier to reference
Set CurList = DialogSheets("Dialog1").ListBoxes("List1")
' Initialize the list so that none of the items are selected
CurList.Selected = _
Array(False, False, False, False, False, False, False, False)
' Show the dialog box and set variable 'chosen' to
' the value returned by the dialog box
chosen = DialogSheets("Dialog1").Show
' If cancel is chosen, exit the procedure
If chosen = 0 Then GoTo canceled
' Set the variable LTemp equal the the array of values indicating
' the selection state of the items in the list box
LTemp = CurList.Selected
'Initialize the Counter variable.
Counter = 1
' Iterate through the loop once for each item in the array (which is
' the same as iterating once for each item in the list box).
For Each LItem In LTemp
' If the value of the current item is True...
If LItem = True Then
' add text to the msgboxtext variable indicating
' that the item is selected
' CurList.List(Counter) returns the selection state of the item
' ("Alpha", "Bravo", etc.).
msgboxtext = msgboxtext & CurList.List(Counter) & _
" is selected. "
' Otherwise...
Else
' Add text to the msgboxtext variable indicating that
' the item is not selected
msgboxtext = msgboxtext & CurList.List(Counter) & _
" is NOT selected. "
End If
' Increment the Counter so we can get the value of the next
' selected item.
Counter = Counter + 1
'repeat until all the items in the list have been checked
Next
' Display a dialog box indicating the selection state
' of each item in the list
MsgBox msgboxtext
' If the Cancel button was chosen, exit procedure
canceled:
End Sub
To run the procedure, choose Macro from the Tools menu. From the Macro Name/Reference list, select ShowSelectedItems and choose Run.
When the dialog box is displayed, select one or more items from the list, and choose the OK button.
A dialog box appears indicating which items in the list were selected and which were not.
You can modify this example and substitute functions that perform tasks by using the selection state of the list items. For example, if you want to insert the current list item into a cell on a worksheet, use this command:
Sheets("Sheet1").Cells(10, 10).Value = CurList.List(Counter)
This puts the current list item into cell J10 on Sheet1.
Although you can establish a link between some types of dialog box controls and a worksheet cell, you can link edit box text only with a Visual Basic procedure. Below is the Visual Basic procedure that creates the equivalent of a cell link between an edit box and cell A1 on a worksheet.
In a new workbook, insert a worksheet (Sheet1), a dialog sheet (Dialog1), and a Visual Basic module (Module1).
Select the Dialog1 sheet tab to activate the dialog sheet.
From the Forms toolbar, choose the Edit Box button. Drag on the dialog frame to create an Edit box. Your dialog frame should appear similar to Figure 3 below.
Figure 3 Edit box to be linked to worksheet cell
On the dialog frame, select the edit box. In the Name box, type Edit Box 1 and press the ENTER key.
Select the Module1 sheet tab, and enter:
Sub Run_Dialog()
' Display the dialog box created on the Dialog1 sheet
DialogSheets("Dialog1").Show
End Sub
Sub EditBox1_Change()
' Enter the text in the Edit Box 1 in cell A1 on Sheet1
Worksheets("Sheet1").Cells(1, 1).Value = _
ActiveDialog.EditBoxes("Edit Box 1").Text
End Sub
To assign EditBox1_Change procedure to the edit box:
Select the Dialog 1 sheet tab.
On the dialog frame, select the edit box, and choose Assign Macro from the Tools menu.
From the Macro Name/Reference list, select EditBox1_Change and choose OK.
To run this example, choose Macro from the Tools menu. From the Macro Name/Reference list, select Run_Dialog, and choose Run.
The EditBox1_Change procedure sets the value of cell A1 equal to the text property of Edit Box 1. When you type text in the edit box in the dialog box and choose OK, the text is entered in cell A1 on Sheet1.
The following example shows how you can change the list displayed in a custom dialog box while the dialog box is still displayed. In this example, the dialog box that you create displays an empty list when you first run the dialog box. When you choose the List One button, a list of different kinds of fruit is displayed in the dialog box. When you choose the List Two button, a list of colors appears in the dialog box.
To add a new dialog sheet to your workbook, choose Macro from the Insert menu, and then choose Dialog.
Use the Forms toolbar to add a list box and two buttons to your dialog box.
Note You can also type the text you want to appear on the custom buttons, such as "List One" and "List Two."
Your dialog box should be similar to the one in Figure 4.
Figure 4 Dialog box for inserting customized list
Select the list box. In the Name box, type "List" (without the quotation marks) and press ENTER.
Select one of the custom buttons (except OK or Cancel), and choose Object from the Format menu. In the Format Object dialog box, select the Control tab. Select the Dismiss check box, and then choose OK.
Repeat Step 4 with the second custom button.
On a worksheet in the workbook, enter the two different lists that you want displayed in the dialog box. For example, enter the following on Sheet1:
A1: Apple B1: Red A2: Orange B2: White A3: Banana B3: Blue A4: Pear B4: Green A5: Grapes B5: Yellow
Insert a new module sheet in your workbook by choosing Macro from the Insert menu, and then choosing Module.
In the new module, enter:
' Dimension variables
Dim chosen As Integer, selected As Integer, MyList As Object
Dim ListOneRange As String, ListTwoRange As String
Sub Main()
' Set value of variable 'chosen' to 1
chosen = 1
' Assign value of variable 'MyList' to listbox in dialog box
Set MyList = Application.DialogSheets("Dialog1").ListBoxes("List")
' Define variable 'ListOneRange' as the cell range
' that contains your first list on the worksheet
ListOneRange = "Sheet1!$A$1:$A$5"
' Define variable 'ListTwoRange' as the cell range
' that contains your second list on the worksheet
ListTwoRange = "Sheet1!$B$1:$B$5"
' Initialize the list displayed in dialog box to be empty
MyList.ListFillRange = ""
' Loop to display the dialog box
' Loop displays the dialog box until it is canceled
While chosen > 0
show:
' Display the dialog box
DialogSheets("Dialog1").show
' If the value of 'chosen' is 1, the List One button was chosen
If chosen = 1 Then
' Set range to first list on worksheet
' and display dialog box again
MyList.ListFillRange = ListOneRange
GoTo show
' If the value of 'chosen' is 2, the List One button was chosen
ElseIf chosen = 2 Then
' Set range to second list on worksheet
' and display dialog box again
MyList.ListFillRange = ListTwoRange
GoTo show
End If
' Repeat loop
Wend
End Sub
Sub OptionOne_Click()
' Set value of variable 'chosen' to 1
chosen = 1
End Sub
Sub OptionTwo_Click()
' Set value of variable 'chosen' to 2
chosen = 2
End Sub
Sub CancelChosen()
' Set value of variable 'chosen' to 0
chosen = 0
End Sub
Sub OKChosen()
' OK button was chosen
' Set value of variable 'selected' to number
' corresponding to the item selected in the list
selected = MyList.ListIndex
If selected = 0 Then
' Alert if no item is selected
MsgBox "nothing selected"
Else
' Display selected item in message box
MsgBox MyList.List(selected)
End If
End Sub
Select the dialog sheet tab. On the dialog frame, select the OK button and choose Assign macro from the Tools menu. From the Macro Name/Reference list, select OKChosen, and choose OK.
Select the Cancel button and choose Assign macro from the Tools menu. From the Macro Name/Reference list, select CancelChosen, and choose OK.
Select the first custom button (List One in this example) and choose Assign macro from the Tools menu. From the Macro Name/Reference list, select OptionOne_Click, and choose OK.
Select the second custom button (List Two in this example) and choose Assign macro from the Tools menu. From the Macro Name/Reference list, select OptionTwo_Click, and choose OK.
To display the dialog box, choose Macro from the Tools menu. From the Macro Name/Reference list, select Main, and choose Run.
When you choose the List One button in the dialog box, the first list (fruit) is displayed. When you select the List Two button, the second list (colors) is displayed. When you choose OK, a dialog box appears with the item that you selected in the list. To close the custom dialog box, choose Cancel.
You can use the SQLRequest function to connect to an external data source and run a query from a worksheet, and then return the result as an array. The SQLExecQuery function executes a query on a data source with a connection that has been established using SQLOpen. Both of these functions are contained in the XLODBC.XLA add-in.
Note You must establish a reference to the XLODBC.XLA file using the References dialog box before you can use either function in a procedure.
If you use the SQLExecQuery function or the SQLRequest function in a Visual Basic procedure to run a query larger than 255 characters on an external data source, your query is truncated after the first 255 characters and the function returns no data. To avoid having your query truncated, you can convert your query string into an array, each element of which can contain up to 255 characters, although this sometimes creates a GP fault if an element in the array is larger than 127 characters.
You can also use the Range object to reference multiple cells that contain your query. Again, you may receive a GP fault if any of the cells in the range that contains your query contain more than 127 characters.
Note This problem has been corrected in Microsoft Excel version 5.0c. Although there still is a 255-character limit when you use a function in the XLODBC.XLA add-in, you no longer receive a GP fault.
You can use either the Array or Range method to avoid receiving a GP fault, and to avoid having your query truncated when you use the SQLExecQuery or the SQLRequest functions with a query larger than 255 characters. Below are examples of each method.
This example uses the QueryToArray function to return your query as an array of values that each contain 127 characters of your query. This array can then be used as your "new" query.
Insert a new module in your workbook.
To reference the XLODBC.XLA add-in in your Visual Basic module, do the following:
From the File menu, choose Open. From the Directories list, select the \LIBRARY\MSQUERY subdirectory of the Microsoft Excel directory. From the File Name list, select XLODBC.XLA and choose OK.
From the Tools menu, choose References. In the Available References list, select the XLODBC.XLA check box, and choose OK.
You are now ready to add your Visual Basic procedure to the module. The following example uses the NWind data source installed with Microsoft Query, and the query used in the example selects data from the Employee table. You can modify this example to use any available data source and table.
In the module, enter:
Sub Return_Data()
' Dimensions variables
Dim chan As Integer, longquery As Variant, query As Variant
' Establish a connection to NWind data source and set
' value of variable 'chan' to channel number returned
' Note that in the following line, C:\WINDOWS should be your
' Microsoft Windows directory
chan = sqlopen("DSN=NWind;DBQ=C:\WINDOWS\MSAPPS\MSQUERY;FIL=dBase4;")
' Set value of variable 'longquery' to query you want to run
longquery = "SELECT employee.ADDRESS, employee.BIRTHDATE, " & _
"employee.CITY, employee.COUNTRY, employee.EMP_TITLE, " & _
"employee.EMPLOY_ID, employee.EXTENSION, " & _
"employee.FIRST_NAME, employee.HIRE_DATE, employee.HOME_PHONE, " & _
"employee.LAST_NAME, employee.NOTES, employee.REGION, " & _
"employee.REPORTS_TO, employee.ZIP_CODE FROM " & _
"c:\windows\msapps\msquery\employee.dbf employee"
' Use 'QueryToArray' function with variable 'longquery'
' Set value of variable 'query' to value returned by function
query = QueryToArray(longquery)
' Execute query using variable 'query' returned by function
SQLExecQuery chan, query
' Return data starting in cell A1 on Sheet1
SQLRetrieve chan, Application.Worksheets("Sheet1").Cells(1, 1)
' Close channel
SQLClose chan
End Sub
Function QueryToArray(Q, Optional MaxLength) As Variant
' Dimension variables
Dim Shift As Integer, Size As Integer, I As Integer
' If no maximum string length is provided (MaxLength), then
' set maximum size of string in array to 127 characters
If IsMissing(MaxLength) Then MaxLength = 127
' Account for Option Base default value
Shift = LBound(Array(1)) - 1
' Determine the number of elements that will be contained
' in the array that this function returns by dividing the
' number of characters in the long query by the maximum
' size of the string
Size = (Len(Q) + MaxLength) \ MaxLength
' Dimension array 'TmpArr'
ReDim tmparr(Size + Shift, 1 + Shift) As String
For I = 1 To Size
' Load array 'TmpArr' with one value for each 127 characters
' of your query
tmparr(I + Shift, 1 + Shift) = _
Mid$(Q, (I - 1) * MaxLength + 1, MaxLength)
Next I
' Assign array returned by QueryToArray function to temparr
QueryToArray = tmparr
End Function
To run your procedure, choose Macro from the Tools menu. From the Macro Name/Reference list, select Return_Data, and choose Run.
The data returned from the query is now contained in cell A9 on Sheet1 in the workbook.
To avoid truncating your query when you use the SQLExecQuery function or the SQLRequest function, you can also use the Range method to reference a query contained in multiple cells on a worksheet. Here is an example of using this method:
Enter the query string on a worksheet in the workbook. For example, on Sheet1 enter:
A1: SELECT employee.ADDRESS, employee.BIRTHDATE, employee.CITY,
A2: employee.COUNTRY, employee.EMP_TITLE, employee.EMPLOY_ID,
A3: employee.EXTENSION, employee.FIRST_NAME, employee.HIRE_DATE,
A4: employee.HOME_PHONE, employee.LAST_NAME, employee.NOTES,
A5: employee.REGION, employee.REPORTS_TO, employee.ZIP_CODE FROM
A6: c:\windows\msapps\msquery\employee.dbf employee
Note To avoid receiving a GP fault when you use this method in a procedure in Microsoft Excel version 5.0, make sure no cell in the range (A1:A6 above) that contains your query contains more than 127 characters.
Insert a new module sheet in the workbook.
Use Steps 1-3 in the above example to establish a reference to the XLODBC.XLA add-in in the module.
In the new module, enter:
Sub From_Worksheet()
' Dimensions variables
Dim chan As Integer, query As Variant
' Establish a connection to NWind data source and set
' value of variable 'chan' to channel number returned
' Note that in the following line, C:\WINDOWS should be your
' Microsoft Windows directory
chan = sqlopen("DSN=NWind;DBQ=C:\WINDOWS\MSAPPS\MSQUERY;FIL=dBase4;")
' Set value of variable 'query' to query contained
' in cells A1:A6 on Sheet1
query = Worksheets("Sheet1").Range("A1:A6")
' Execute query using variable 'query' returned from worksheet
SQLExecQuery chan, query
' Return data to cell A9 on Sheet1
SQLRetrieve chan, Application.Worksheets("Sheet1").Cells(9, 1)
' Close channel
SQLClose chan
End Sub
To run the procedure, choose Macro from the Tools menu. From the Macro Name/Reference list, select From_Worksheet, and choose Run.
The data returned from the query is now contained in cell A9 on Sheet1 in the workbook.
The following examples allow you to save a file in Microsoft Excel version 5.0 as a Microsoft Excel 4.0 worksheet or workbook by default. This is useful if individuals in your company use Microsoft Excel versions 5.0 and 4.0, and often share files. Because you cannot open Microsoft Excel version 5.0 files in Microsoft Excel version 4.0, you may need to save your Microsoft Excel version 5.0 files in the Microsoft Excel 4.0 Worksheet or Workbook file format.
Two different examples are provided below. The first example, SimpleSaveAs, saves the active worksheet to the Microsoft Excel 4.0 Worksheet file format by default. The second example, SaveAsXL4, is a more complex procedure which allows you to save the active worksheet as a Microsoft Excel 4.0 worksheet, multiple worksheets as individual Microsoft Excel 4.0 worksheets, or multiple worksheets as a Microsoft Excel 4.0 Workbook.
This procedure saves the active workbook worksheet as a Microsoft Excel 4.0 Worksheet file by default. In a new module sheet, enter:
' Procedure to automatically save file in Microsoft Excel
' 4.0 Worksheet format
Sub SimpleSaveAs()
' Dimension variables
Dim worksheet As Boolean, strsavetoname As String
' Call function CheckWorksheet() to see if active sheet is a worksheet
worksheet = CheckWorksheet
' If active sheet is a worksheet, warn user that only the
' active sheet will be saved
If worksheet Then
MsgBox "Only the active worksheet will be saved. If other " & _
"sheets contain data, please save them individually.", _
vbOKOnly + vbInformation
' Display the Save As dialog box and assign variable 'strsavetoname'
' to text entered in File Name box
strsavetoname = _
Application.GetSaveAsFilename(InitialFilename:=ActiveSheet.Name & _
".xls", FileFilter:="Microsoft Excel Files (*.xl*),*.xl*")
' Check to see if dialog box is canceled
If strsavetoname = False Then GoTo cancel
' Save file as Microsoft Excel 4.0 worksheet file with name
' entered in File Name box
ActiveSheet.SaveAs Filename:=strsavetoname, _
FileFormat:=xlExcel4, CreateBackup:=False
Else
' If active sheet is not a worksheet, warn user that
' this sheet cannot be saved
MsgBox "The current sheet is not a worksheet and cannot " & _
"be saved as a Microsoft Excel 4.0 Workbook. " & _
" Select a worksheet and save again."
End If
cancel:
End Sub
' Function returns True if active sheet is a worksheet, False if not
Function CheckWorksheet() As Boolean
' Dimension variables
Dim worksheet As Boolean, sheet As Object
' Set initial value of variable 'worksheet' to False
worksheet = False
' Compare sheet name with names of worksheets in the workbook
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Name = ActiveSheet.Name Then
' Active sheet is worksheet, return value True
CheckWorksheet = True
End If
Next
End Function
When you run this procedure, it checks to see if the active sheet is a worksheet. If it is, you receive a message indicating that only that active worksheet will be saved, and that if other worksheets in the workbook contain data, you should save them individually. The Save As dialog box then appears with the name of the worksheet in the File Name box. When you choose OK, the file is saved to the current directory as a Microsoft Excel 4.0 worksheet.
If the active sheet is not a worksheet, you receive a message telling you that the active sheet cannot be saved as a Microsoft Excel 4.0 worksheet, and that you must select an active worksheet and save the file again.
For information about how to add this procedure to a menu, and to save the procedure as an add-in, see the "Adding Command to Menu" section below.
This example is a little more complex than the SimpleSaveAs example above, and offers more options for how the file is saved. When you run this procedure, you can save the file in the normal Microsoft Excel 5.0 format, or the Microsoft Excel 4.0 format. If you choose to save the file in the Microsoft Excel 4.0 format, you have three choices:
save only the active worksheet as a Microsoft Excel 4.0 worksheet
save all worksheets in the workbook as individual Microsoft Excel 4.0 worksheets
save all the worksheets in the active workbook as a Microsoft Excel 4.0 workbook
Follow this procedure:
In a new workbook, insert a new dialog sheet by choosing Macro from the Insert menu, and then choosing Dialog.
From the Format menu, choose Sheet, and then choose Rename. In the Name box, type dIntro. You can modify this example to use any sheet name; this example uses dIntro.
Use the Forms toolbar to add one Label and two Option Buttons to the dialog frame. The dialog box should appear as in Figure 5, although the wordings may differ.
Figure 5 Dialog frame for setting file save options
From the Insert menu, choose Macro, and then choose Dialog to insert a new dialog sheet.
From the Format menu, choose Sheet, and then choose Rename. In the Name box, type dSaveopt. Again, you can modify this example to use any sheet name; this example uses dSaveopt.
Use the Forms toolbar to add one Label, and three Option Buttons. Your dialog frame should appear as in Figure 6, although the wording may differ.
Figure 6 Save option dialog frame
From the Insert menu, choose Macro, and then choose Module to insert a new module sheet. In the new module, enter:
' Main procedure, displays a message asking user if file will be shared
' presents the choice to save the file as a Microsoft Excel
' version 4.0 or 5.0 file
' Dimension global variables
Dim strWkshts() As String
Dim decsn As Integer
Sub SaveAsXL4()
' Dimension variables
Dim result As Variant, dlg1 as Object
' Set variable 'dlg1' equal to the dialog sheet dIntro
' to make referencing easier
Set dlg1 = ThisWorkbook.DialogSheets("dIntro")
' Initialize controls
' set default option to save as version 5.0
dlg1.OptionButtons(1).Value = xlOn
' Display dialog box, and set variable 'result'
' equal to the value returned by the dialog box
result = dlg1.Show
' If Cancel is chosen, exit procedure
If result = 0 Then End
' If the first option is selected, save the file
' as a version 5.0 workbook
If dlg1.OptionButtons(1).Value = xlOn Then
' If file has not been saved before, display Save As dialog box
If Left$(ActiveWorkbook.Name, 4) = "Book" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
' If file has been saved before, save file without
' displaying dialog box
ActiveWorkbook.Save
End If
' If second option is selected, save file as version 4.0 file
' call XL4SaveRoutine procedure
Else
XL4SaveRoutine
End If
End Sub
' Subroutine searches for worksheets that contain data, and
' prompts user to choose whether to save data on that
' worksheet
Sub XL4SaveRoutine()
' Dimension variables
Dim worksheet as Boolean, decsn as Integer
Dim strsavetoname as String
' Set worksheet variable equal to value returned
' by CheckWorksheet function
' Check to see if active sheet is a worksheet
worksheet = CheckWorksheet()
' If sheet is not a worksheet, display message asking
' to select worksheet that contains data and save file again
If Not worksheet Then
MsgBox "Active sheet is not a worksheet. Select a Worksheet" & _
" that contains data and save file again"
' Exit procedure
GoTo canceled
End If
' If active sheet is workhsheet, call FindSheetsWithData subroutine
' to check for worksheets that contain data
FindSheetsWithData
' If no worksheets in workbook contain data,
' alert that file is not saved
If UBound(strWkshts) = 1 Then
MsgBox "There are no worksheets that contain data in this" & _
" workbook. File not saved."
' Exit procedure
GoTo canceled
End If
' If workbook contains multiple worksheets that contain data,
' present options for saving the file
If UBound(strWkshts) - 1 > 1 Then
' Call decision2 function to present options for saving file
decsn = decision2()
End If
' If cancel button was chosen, exit procedure
If decsn = 99 Then GoTo canceled
' Check for option selected
Select Case decsn
' No other worksheets in workbook contain data
' Save only the active worksheet
Case 0
' Display Save As dialog box
' assign name entered in File Name box to variable 'strsavetoname'
strsavetoname = _
Application.GetSaveAsFilename(InitialFilename:=ActiveSheet.Name & _
".xls", FileFilter:="Microsoft Excel Files (*.xl*),*.xl*")
' If Cancel button is chosen in Save As dialog box, exit procedure
If strsavetoname = False Then GoTo canceled
' Save the active worksheet as a Microsoft Excel 4.0
' worksheet with name entered in Save As dialog box
ActiveSheet.SaveAs Filename:=strsavetoname, _
FileFormat:=xlExcel4, CreateBackup:=False
' Workbook contains multiple worksheets that contain data
' but option chosen to save only the active worksheet
Case 1
' Display Save As dialog box
' assign name entered in File Name box to variable 'strsavetoname'
strsavetoname = _
Application.GetSaveAsFilename(InitialFilename:=ActiveSheet.Name & _
".xls", FileFilter:="Microsoft Excel Files (*.xl*),*.xl*")
' If Cancel button is chosen in Save As dialog box, exit procedure
If strsavetoname = False Then GoTo canceled
' Save the active worksheet as a Microsoft Excel 4.0
' worksheet with name entered in Save As dialog box
ActiveSheet.SaveAs Filename:=strsavetoname, FileFormat:=xlExcel4, _
CreateBackup:=False
' Option chosen to save each worksheet that contains data as an
' individual Microsoft Excel 4.0 worksheet
Case 2
' Dimension variable
Dim idx As Integer
' Loop through each worksheet that contains data in the workbook
For idx = 1 To (UBound(strWkshts) - 1)
' Display Save As dialog box
' assign name entered in File Name box to variable 'strsavetoname'
strsavetoname = _
Application.GetSaveAsFilename(InitialFilename:=strWkshts(idx) & _
".xls", FileFilter:="Microsoft Excel Files (*.xl*),*.xl*")
' If Cancel button is chosen in Save As dialog box, exit procedure
If strsavetoname = False Then GoTo canceled
' Save each worksheet that contains data as a
' Microsoft Excel 4.0 worksheet file
ActiveWorkbook.Worksheets(strWkshts(idx)).SaveAs _
Filename:=strsavetoname, FileFormat:=xlExcel4, _
CreateBackup:=False
' Repeat loop for next worksheet that contains data in the workbook
Next idx
' Save each worksheet in a Microsoft Excel 4.0 workbook
Case 3
' Display Save As dialog box
' assign name entered in File Name box to variable 'strsavetoname'
strsavetoname = _
Application.GetSaveAsFilename(InitialFilename:=ActiveSheet.Name & _
".xls", FileFilter:="Microsoft Excel Files (*.xl*),*.xl*")
' If Cancel button is chosen in Save As dialog box, exit procedure
If strsavetoname = False Then GoTo canceled
' Save worksheets that contain data as Microsoft Excel 4.0 workbook
ActiveSheet.SaveAs Filename:=strsavetoname, _
FileFormat:=xlExcel4Workbook, CreateBackup:=False
End Select
' Cancel chosen, exit procedure
canceled:
End Sub
' Searches workbook for all worksheets that contain data
Sub FindSheetsWithData()
' Dimension variables
Dim wksht As worksheet
ReDim strWkshts(1)
' Loop through each worksheet in the workbook
For Each wksht In ActiveWorkbook.Worksheets
' If the worksheet contains data, add the worksheet
' name to the array of names strWkshts()
If Not wksht.UsedRange.Address = "$A$1" Or Not _
wksht.Range("A1").Formula = "" Then
strWkshts(UBound(strWkshts)) = wksht.Name
ReDim Preserve strWkshts(UBound(strWkshts) + 1)
End If
' Check the next worksheet
Next
End Sub
' File contains multiple worksheets that contain data
' Prompt for the method of saving the file
Function decision2() As Integer
' Dimension variables
Dim idx As Integer, result As Variant
Dim dlg2 as object
' Set value of variable 'dlg2' to dSaveopt dialog
' sheet to make referencing easier
Set dlg2 = ThisWorkbook.DialogSheets("dSaveopt")
' Initialize variables, set default option button to first option
dlg2.OptionButtons(1).Value = xlOn
' Display dSaveopt dialog box
' Set variable 'result' to result of dialog box
result = dlg2.Show
' If Cancel button is chosen, set value of idx to 99
' and don't evaluate selected option
If result = False Then
decision2 = 99
GoTo cancel
End If
' If first option is selected, set value of idx to 1
If dlg2.OptionButtons(1).Value = xlOn Then idx = 1
' If second option is selected, set value of idx to 2
If dlg2.OptionButtons(2).Value = xlOn Then idx = 2
' If third option is selected, set value of idx to 3
If dlg2.OptionButtons(3).Value = xlOn Then idx = 3
' Set value of function decision2 to value of variable 'idx'
decision2 = idx
' Cancel chosen, exit function
cancel:
End Function
' Function returns True if active sheet is a worksheet, False if not
Function CheckWorksheet() As Boolean
' Dimension variables
Dim worksheet As Boolean, sheet As Object
' Set initial value of variable 'worksheet' to False
worksheet = False
' Compare sheet name with names of worksheets in the workbook
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Name = ActiveSheet.Name Then
' Active sheet is worksheet, return value True
CheckWorksheet = True
End If
Next
End Function
You can create an add-in file that contains the procedure and adds it to a menu, then distribute the add-in file to other individuals, who can open or load the add-in file and run the procedure by choosing the menu item to which you assigned the procedure.
Follow these steps to create an add-in file that contains the procedure:
Remove any unnecessary sheets from the workbook that contains the procedure.
Select the module that contains the procedure, and choose Menu Editor from the Tools menu.
Note This command is available only when the active sheet is a module.
From the Menus list, select the menu on which you want the procedure command to appear.
From the Menu Items list, select the item above which you want the new menu command to appear.
Note If you want the new item to appear at the bottom of the menu, select (End of menu).
Choose the Insert button.
In the Caption box, type the text that you want to appear on the menu, such as Save As XL 4.0. From the Macro list, select the procedure that you want to add to the menu, such as SimpleSaveAs or SaveAsXL4 that you created above.
Choose OK.
From the Tools menu, choose Make Add-in.
In the File Name box, type the name of the add-in file, such as savexl4 and choose OK.
You can now distribute this file to individuals so that they can use the procedure. When they open this add-in file, or load the file using the Add-Ins dialog box, the new menu command appears, and they can choose the command to run the procedure.
Note You cannot open an add-in (.XLA) file to modify the contents of the file. When you close the workbook you used to create the add-in, you receive the following message as a reminder:
Figure 7 Reminder message to save changes in workbook
It is a good idea to save the workbook that you used to create the add-in file so you have a copy you can modify and use to create a newer version of the add-in if necessary.
Customizing your working environment is an easy and effective way to increase productivity. These macros can make working with Microsoft Excel 5.0 easier by automating some of the tasks you otherwise would have to perform repeatedly, or by allowing you to customize and distribute useful procedures.
Written: February 24, 1995
Tonya Wishart has worked in Product Support for Microsoft for the last 4.5 years. Currently, she is the Knowledge Base writer for Office, Excel, and Project.
Microsoft TechNet
May 1995
Volume 3 Issue 5
Go To TechNet Home Page
Go To Microsoft Home Page