-- text figures

Figure 12 Security Levels

Level
Description

High
Only signed macros from trusted sources will be allowed to run. Unsigned macros are automatically disabled.

Medium
You can choose whether to run potentially unsafe macros.

Low
Not recommended. You are not protected from potentially unsafe macros. Use this setting only if you have virus scanning software installed or you are sure all documents you open are safe.

Figure 15 CommonRoutines.bas

'This module contains common routines for the Sales Report COM add-in.
Option Explicit
Function AddCommandBar(parentApp As Object, addinInst As COMAddIn) As Object
    'Adds a command bar with a button to the parent application and
    'returns a CommanBar control button
    
    Dim cbMenu As CommandBar
    Dim cbctlMenuItem As Office.CommandBarControl
    
    'Store a reference to the parent app
    'Set gParentApp = parentApp
    
    'Is the toolbar already there?
    On Error Resume Next
    Set cbMenu = parentApp.CommandBars("Sales Reports")
    
    'If not then create it
    If cbMenu Is Nothing Then
        Set cbMenu = parentApp.CommandBars.Add("Sales Reports")
    End If
    
    'Make it visible, reset it, and dock it at the top of the window
    cbMenu.Visible = True
    cbMenu.Reset
    cbMenu.Position = msoBarTop
    
    'Delete all items in the command bar (just in case)
    For Each cbctlMenuItem In cbMenu.Controls
        cbctlMenuItem.Delete
    Next
    
    'Create a new button to put in the command bar
    Set cbctlMenuItem = cbMenu.Controls.Add(MsoControlType.msoControlButton)
    cbctlMenuItem.Caption = "Daily Sales"
    cbctlMenuItem.Style = MsoButtonStyle.msoButtonCaption
    cbctlMenuItem.OnAction = "!<" & addinInst.ProgId & ">"
    cbctlMenuItem.Tag = "Daily Sales"
    
    'Return the object for the event sink
    Set AddCommandBar = cbctlMenuItem
End Function

Sub RemoveCommandBar(parentApp As Object)
    'Removes the command bar from the parent application
    On Error Resume Next
    parentApp.CommandBars("Sales Reports").Delete
End Sub

Function GetRecordSet() As ADODB.Recordset
'An application independent function that
'displays the date dialog and returns a recordset
'based on the selected date, if not records are found
'it displays a message and returns null

'Variables
Dim datestring As String
Dim datedlg As frmDateDialog
Dim de As deSalesDatabase
Dim sql As String
Dim rs As ADODB.Recordset

'Display a date dialog
Set datedlg = New frmDateDialog
datedlg.Show vbModal

'If the user cancelled exit
If datedlg.getCancelled Then Exit Function

'Get the date the user selected
datestring = datedlg.getSelectedDate

'Create the SQL statement
sql = "select * from sales_table where DateOfSale=#" & datestring & "#"

'Connect to the database
Set de = New deSalesDatabase
de.Connection1.Open

'Get a recordset
Set rs = de.Connection1.Execute(sql)

'Any records? If not message the user.
If rs.EOF Then
    MsgBox "No sales records for the selected date."
End If

'Return the recordset to the caller
Set GetRecordSet = rs

End Function

Figure 17 Add-in Designer Code

'Turn on explicit variable declarations
Option Explicit

'Declare that this module implements the IDTExtensibilit2 interface
Implements IDTExtensibility2

'Declare a command bar button that receives events
Public WithEvents ButtonEventHandler As Office.CommandBarButton

'Create a gobal variable to store a reference to the host app
Dim gParentApp As Object

Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal \ 
	onnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal addinInst As Object, \
	custom() As Variant)
    'Called by the parent application when this add-in is loaded
    
    'Add a command bar with a button and listen to it's events
    Set ButtonEventHandler = AddCommandBar(Application, addinInst)
    
    'Store a reference to the parent application for later use
    Set gParentApp = Application    
End Sub

Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As \ 
	ddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
    'Called by the parent application when this add-in is unloaded
    RemoveCommandBar gParentApp
End Sub

Private Sub ButtonEventHandler_Click(ByVal Ctrl As Office.CommandBarButton, \ 
	ancelDefault As Boolean)
    'Handles the event generated by the user clicking the 'Daily Sales' button
    '<<Call an application-specific function here>>
End Sub

'The code below is needed to properly implement the IDTExtensibility2 interface
'
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
'Need at least a comment so compiler doesn't remove implementation
End Sub

Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
'Need at least a comment so compiler doesn't remove implementation
End Sub

Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
'Need at least a comment so compiler doesn't remove implementation
End Sub

Figure 20 Creating a User Form

Figure 20: Creating a User Form

Figure 21 ApplicationSpecific.bas

' Option Explicit

Sub GetDailySalesReportForWord(wordapp As Word.Application)
'This is an application-specific procedure that formats
'daily sales information for Word

'Variables
Dim rs As ADODB.Recordset
Dim rngText As Word.Range
Dim tbl As Word.Table
Dim row As Word.row

'Get a recordset from the common database query routine
Set rs = GetRecordSet

'Get any data? If not, then exit
If rs Is Nothing Then Exit Sub
If rs.EOF Then Exit Sub

'Get the current range
Set rngText = wordapp.Selection.Range

'Add a new table
Set tbl = wordapp.Selection.Tables.Add(rngText, 1, 2)

'Add a header row
Set row = tbl.Rows(1)
row.Cells(1).Range.InsertAfter ("Sales Person")
row.Cells(2).Range.InsertAfter ("Amount Sold")

'Loop through each record and add rows to the table
While Not rs.EOF
    Set row = tbl.Rows.Add
    row.Cells(1).Range.InsertAfter rs(1)
    row.Cells(2).Range.InsertAfter Format(rs(3), "$0.00")
    rs.MoveNext
Wend

'Close the recordset
rs.Close
Set rs = Nothing

End Sub
Sub GetDailySalesReportForExcel(excelapp As Excel.Application)
'This is an application-specific procedure that formats
'daily sales information for Microsoft Excel

'Variables
Dim rs As ADODB.Recordset
Dim rng As Excel.Range
Dim irow As Integer

'Get a recordset from the common database query routine
Set rs = GetRecordSet

'Get any data? If not, then exit
If rs Is Nothing Then Exit Sub
If rs.EOF Then Exit Sub

'Get the range of the current selection
Set rng = excelapp.Selection

'Loop through each record and add rows to the table
rng(1, 1).Value = "Sales Person"
rng(1, 2).Value = "Amount Sold"
irow = 2
Dim c As cell

While Not rs.EOF
    'Insert Sales person name
    rng(irow, 1).Value = rs(1)
    
    'Insert sales amount
    rng(irow, 2).Value = rs(3)
    
    'Format as currency
    rng(irow, 2).NumberFormat = "$#,##0.00"
    
    'Move to the next record
    rs.MoveNext
    irow = irow + 1
Wend

'Close the recordset
rs.Close
Set rs = Nothing

End Sub
Sub GetDailySalesReportForFrontPage(fpapp As frontpage.Application)
'This is an application-specific procedure that formats
'daily sales information for FrontPage
Dim rs As ADODB.Recordset
Set rs = GetRecordSet
Dim body As FrontPageEditor.FPHTMLBody
Dim htmlstring As String

'Get any data? If not, then exit
If rs Is Nothing Then Exit Sub
If rs.EOF Then Exit Sub

'Get a reference the body of the active document
Set body = fpapp.ActiveDocument.all.tags("BODY").Item(0)

'Begin an HTML table
htmlstring = "<table>" & vbCrLf

'Create an html string to a
'Add a header row to the table
htmlstring = htmlstring & "<tr><td>Sales Person</td><td>Amount Sold</td></tr> " & vbCrLf

'Loop through the records and add them to the table
While Not rs.EOF
    
    'Begin a new table row
    htmlstring = htmlstring & "<tr>"
    
    'Insert Salesperson name
    htmlstring = htmlstring & "<td>"
    htmlstring = htmlstring & rs(1)
    htmlstring = htmlstring & "</td>"
    
    'Insert Sales amount
    htmlstring = htmlstring & "<td>"
    htmlstring = htmlstring & Format(rs(3), "$0.00")
    htmlstring = htmlstring & "</td>"
    
    'End the row
    htmlstring = htmlstring & "</tr>" & vbCrLf
    
    'Move to the next record
    rs.MoveNext
Wend

'End the table
htmlstring = htmlstring & "</table>" & vbCrLf

'Put the html string into the body of the html document
body.innerHTML = body.innerHTML & htmlstring

'Close the recordset
rs.Close
Set rs = Nothing

End Sub

Level	Description
High	Only signed macros from trusted sources will be allowed to run. Unsigned macros are automatically disabled.
Medium	You can choose whether to run potentially unsafe macros.
Low	Not recommended. You are not protected from potentially unsafe macros. Use this setting only if you have virus scanning software installed or you are sure all documents you open are safe.