I have put some serious hours into to trying to make this invoice template
work with Office 2007 and Windows 7. It came originally with Office 97 and
Office 2000 and was designed by Village Software for Excel usage. What is
nice about it is that it has a visual basic database attached to it to track
fields of data on the invoice. I have tried everything to make this darn
thing work and I really need it for my business. The file names that I copied
over to Windows 7 are:

INVDB.XLS
TMPLTNUM.XLS
WZTEMPLT.XLS

I pasted these files into location C:/Program Files (x86)/Microsoft
Office/Office12/Library as some on the net have suggested to do in XP (except
it would be Office11). I have successfully performed this feat in XP with
Office 2003 but not Office 2007 in Windows 7. Keep in mind that I did change
the file location of INVDB.XLS in the template but everytime I try to save
the file it says "cannot locate ...INVDB.XLS". I also do not get the number
toolbar to sequentially increase the invoice number manually.

Has anyone successfully made this awesome template work with Office 2007? I
know it can be done unless the VBA between the two Office versions are not
compatible.

I even created new folders for placement of the above three files in C:
/Program Files/Microsoft Office/Office/Library and no go.

jberenyi wrote:
>I have put some serious hours into to trying to make this invoice template
>work with Office 2007 and Windows 7. It came originally with Office 97 and
>Office 2000 and was designed by Village Software for Excel usage. What is
>nice about it is that it has a visual basic database attached to it to track
>fields of data on the invoice. I have tried everything to make this darn
>thing work and I really need it for my business. The file names that I copied
>over to Windows 7 are:
>
>INVDB.XLS
>TMPLTNUM.XLS
>WZTEMPLT.XLS
>
>I pasted these files into location C:/Program Files (x86)/Microsoft
>Office/Office12/Library as some on the net have suggested to do in XP (except
>it would be Office11). I have successfully performed this feat in XP with
>Office 2003 but not Office 2007 in Windows 7. Keep in mind that I did change
>the file location of INVDB.XLS in the template but everytime I try to save
>the file it says "cannot locate ...INVDB.XLS". I also do not get the number
>toolbar to sequentially increase the invoice number manually.
>
>Has anyone successfully made this awesome template work with Office 2007? I
>know it can be done unless the VBA between the two Office versions are not
>compatible.
>
>I even created new folders for placement of the above three files in C:
>/Program Files/Microsoft Office/Office/Library and no go.

Here is the code:



' **********************************************
' *     MS-Excel™ Template Control Code        *
' *  Copyright © 1994-6 Village Software, Inc. *
' *           All Rights Reserved              *
' *      LICENSED FOR END-USER USE ONLY.       *
' *   CODE MAY NOT BE INCLUDED IN COMMERCIAL   *
' *    THIRD PARTY APPLICATIONS WITHOUT THE    *
' *        EXPRESSED WRITTEN CONSENT OF        *
' *           VILLAGE SOFTWARE, INC.           *
' *                                            *
' *                Version 8.0                 *
' **********************************************

' These routines control the behavior of the toolbars,
' buttons, and other user-interface elements of the
' MS-Excel 95 templates


' ****************************************************
' * Global options, types, declarations, & constants *
' ****************************************************

    Option Base 1
    
    Public LetterFont As String
    Public LetterStyle As String
    Public LetterColor As Integer
    Public LetterSize As Integer


    Public UnqNumber As Variant
    Public Cloak_Next As Boolean
    Public MacXL As Boolean
    Global GenNumber As Long
    Global BookName As String
    Global FullBookName As String
        
    Const SheetBar = "Invoice"
    Const NumberingFilename = "Invoice"
    Const Vital = "Customize Your Invoice"
    Const Content1 = "Invoice"
    
    Const Lock_String = "Lock/Save Sheet"
    Const Lock_Text = "You can lock the information on the Customize page and
save your customized version of the template."
    Const Unlock_String = "Unlock This Sheet"
    Const Unlock_Text = "By unlocking this sheet, you enable changes to be
made to the information on the Customize sheet. Select ""Lock This Sheet""
after you make your changes to protect the sheet from accidental changes."
    Const Save_Alrt = "Your new customized template has been saved to the
directory "
    Const Save_Alrt2 = ".  To begin use, click Close from the File menu and
then click New to open your template."
    Const Save_Filter = "Templates,*.xlt"
    Const Save_Title = "Save Template"
    
    Const Logo_Error = "You must unlock the Customize sheet to change the
logo for this template."
    Const LetterFont_Error = "You must unlock the Customize sheet to change
the lettertype for this template."
    Const Univ_Error = "Unexpected Error #"

    Const ATW_NotThere = "To use this feature, you must first install the
Template Wizard add-in program.  For installation instructions, click Help."
    Const ATW_SheetName = "TemplateInformation"
    
    Const SQ_DB_Loc = "There is no Common database in the specified directory.
Please reset the database location in the Customize page."
    Const SQ_DB_Struc = "This database structure is not compatible with the
template.  Please restore original structure."
    Const SQ_DB_CatTitle = "Product and Service Catalog"
    Const SQ_DB_CatItem = "Product/Service Name"
    Const SQ_DB_EmpTitle = "Employee Info"
    Const SQ_DB_EmpItem = "Name"
    
    Const NUM_Hdr = "Assign a Number"
    Const NUM_Warn1 = "You have asked for a unique number to be permanently
assigned to this form.  Is it OK to proceed?"
    Const NUM_Warn2 = "A unique number is already assigned to this form.
Changing it may cause you bookkeeping problems.  Do you really want to assign
a new number?"
    Const NUM_NotThere = "The numbering add-in must be loaded for optimal
numbering and toolbar behavior.  Please load this add-in into your Library
directory."
    Const Num_Prob = "An error occurred while trying to assign a number.
Please ensure that the path specified on the Customize sheet is valid, or
enter a number manually."
    
    Const VIL_Dlg = "Village Software provides a variety of business and
financial spreadsheet solutions for Excel -- for both business and home use.
For a free catalog, call 617-695-9332 or write to Village Software, 186
Lincoln Street, Boston MA 02111 USA."
    Const VIL_Dlg2 = "To switch back to the sheet you were working on, use
the Window command on the menu."
    
    Const EmpDlg = "Select Employee"
    Const LockDlg = "Lock"
    Const CredDlg = "Credits"
    
    Const ZoomButton = 1
    Const TipButton = 2
    Const DocButton = 3
    Const HelpButton = 4
    Const SampleButton = 5
    Const NumbersButton = 6
    Const ATWButton = 7
    Const CredButton = 8
 
    Const Zoom1 = 80
    Const Zoom2 = 95
    Const Zoom3 = 105
    
    Const DatabasePathCell = "B3"
    Const LocalizationCell = "LOC"
    Const SampleStateCell = "SS"
    Const ToolBarStateCell = "NS"
    Const CommonDBPathCell = "CDB"
    Const ContentSheetCell = "CS"
    
    Const File_ATW = "WZTEMPLT"
    Const File_Number = "TMPLTNUM"
    Const File_Help = "XLTMPL8.HLP"
    Const File_Help_Mac = "MS Excel Solutions Help"
    Const File_Help_Main = "XLMAIN8.HLP"
    Const File_Help_Main_Mac = "MS Excel Help"
    Const File_DB = "COMMON"

    Const Cloak = True
    Const Default_Font = "Arial"

    Const cRange = "Range"
    Const cWorksheet = "Worksheet"
    Const cNothing = "Nothing"
    Const cEmpty = "Empty"

    'For the intl.Fixup macro:
    Const TRIGGER_NAME = "__IntlFixup"
    Const TABLE_NAME = "__IntlFixupTable"


' ***********************************
' * Automatic execution procedures  *
' ***********************************


Sub Auto_Open()
'Initializes the worksheet properties

    Application.ScreenUpdating = False
    IntlFixup
    MacXL = (UCase(Left(Application.OperatingSystem, 3)) = "MAC")
       
    If CheckBars(SheetBar) Then
      If Int(Left(Application.Version, 1)) > 5 Then
        Toolbars(SheetBar).ToolbarButtons(ZoomButton).OnAction = "PageZoom"
        Toolbars(SheetBar).ToolbarButtons(TipButton).OnAction =
"CellTipDisplay"
        Toolbars(SheetBar).ToolbarButtons(HelpButton).OnAction = "Help"
        Toolbars(SheetBar).ToolbarButtons(SampleButton).OnAction =
"ToggleSample"
      Else
        Toolbars(SheetBar).Delete
        Exit Sub
      End If
    End If

    If Not CheckAddIns(File_Number & ".XLA", Ttl) Then
      MsgBox NUM_NotThere, vbOKOnly + vbCritical, SheetBar
    End If
    
    ActiveWorkbook.OnSheetActivate = "CheckSheet"
    ActiveWorkbook.OnSheetDeactivate = "CloakSheet"
    ActiveWindow.OnWindow = "CheckWindow"
    
    For Each ThisSheet In Sheets
      If TypeName(ThisSheet) = cWorksheet Then
        ThisSheet.OnEntry = "CheckEntry"
      End If
    Next
    
    LetterFont = Default_Font
    Application.DisplayNoteIndicator = True
    
    FullBookName = ActiveWorkbook.Name
    BookName = ParentWorkbook(FullBookName)
    
    AutoScale
    
    Range(LocalizationCell) = Application.International(1)
    Range(ContentSheetCell) = Sheets(Content1).Name
    If CheckSheets(ATW_SheetName, ActiveWorkbook.Name) Then
        If Sheets(ATW_SheetName).Range(DatabasePathCell).Value = _
         FlName(Sheets(ATW_SheetName).Range(DatabasePathCell).Value) Then
            Sheets(ATW_SheetName).Range(DatabasePathCell).Value = Application.
LibraryPath & _
             Application.PathSeparator & FlName(Sheets(ATW_SheetName).Range
(DatabasePathCell).Value)
        End If
    End If
    
    Specific_AutoStart
    
    'Application.ScreenUpdating = True
    
End Sub

       
Sub IntlFixup()
    Dim wbTemplate As Workbook
    Dim wbDataTable As Workbook
    Dim v As Variant
    Dim rTable As Range
    Dim rCurCell As Range
    Dim rDestCell As Range
    Dim iLocaleOffset As Integer
    Dim rSrcCell As Range
    
    ' if somebody absolutely had to have the table in a different workbook,
    ' make it easy on them.  Just change these definitions to affect the rest
    ' of the macro.  Could also pass info as parameters if required.
    Set wbTemplate = ThisWorkbook
    Set wbDataTable = ThisWorkbook
    
    On Error Resume Next
    Set v = Nothing
    Set v = wbTemplate.Names(TRIGGER_NAME)
    If Not (v Is Nothing) Then Exit Sub
    
    Set rTable = wbDataTable.Names(TABLE_NAME).RefersToRange
    If rTable Is Nothing Then
        MsgBox "Warning: Missing Localization Table"
        Exit Sub
    End If
    
    ' lookup the locale offset within the table.  After found, it is just a
constant
    ' offset into the table columns.  If not found, bail out silently
    v = Application.Match(Application.International(xlCountrySetting), _
        rTable.Rows(1).Cells.Offset(0, 3).Resize(columnsize:=rTable.Columns.
Count - 3), 0)
    If Not IsError(v) Then
        iLocaleOffset = CInt(v) - 1

        Set rCurCell = rTable.Cells(2, 1)
        Do Until IsEmpty(rCurCell.Value)
            Set rDestCell = wbTemplate.Sheets(rCurCell.Value).Range(rCurCell.
Offset(0, 1).Value)
            Set rSrcCell = rCurCell.Offset(0, 3 + iLocaleOffset)
            If Not IsEmpty(rSrcCell) Then
                Select Case rCurCell.Offset(0, 2).Value
                    Case 1
                        ' contents
                        rDestCell.Value = rSrcCell.Value
                    Case 2
                        ' number format
                        rDestCell.NumberFormatLocal = rSrcCell.Value
                    Case 3
                        ' formula
                        rDestCell.Formula = "=" & rSrcCell.Formula
                    Case 4
                        ' paper size (applies to entire worksheet)
                        rDestCell.Parent.PageSetup.PaperSize = rSrcCell.Value
                    Case Else
                        ' do nothing - a bogus entry in the localization
table
                        MsgBox "Warning: invalid action code entry in
localization table"
                End Select
            End If
            Set rCurCell = rCurCell.Offset(1, 0)
        Loop
    End If
    
    ' add the trigger name so that this template never gets fixed up again.
    wbTemplate.Names.Add Name:=TRIGGER_NAME, RefersTo:="=True", Visible:
=False
End Sub


Sub Auto_Close()
'Orderly closedown/pass-off of toolbars, etc.

    Unhide_Workbook ThisWorkbook.Name
    
    If CheckBars(SheetBar) Then
        
        If BookName = "" Then
            BookName = ParentWorkbook(ActiveWorkbook.Name)
        End If
        
        If IsNull(SiblingWorkbooks(BookName, 1)) Then
            Toolbars(SheetBar).Delete
            Application.OnWindow = ""
        Else
            TransName = SiblingWorkbooks(BookName, 1)
            Toolbars(SheetBar).ToolbarButtons(ZoomButton).OnAction = _
              TransName & "!PageZoom"
            Toolbars(SheetBar).ToolbarButtons(TipButton).OnAction = _
              TransName & "!CellTipDisplay"
            Toolbars(SheetBar).ToolbarButtons(HelpButton).OnAction = _
              TransName & "!Help"
            Toolbars(SheetBar).ToolbarButtons(SampleButton).OnAction = _
              TransName & "!ToggleSample"
            
            If NumbersButton <> 0 Then
                Toolbars(SheetBar).ToolbarButtons(NumbersButton).OnAction = _
                  TransName & "!AssignNumbers"
            Else
                Toolbars(SheetBar).ToolbarButtons(SplitButton).OnAction = _
                  TransName & "!SplitWindow"
            End If
            
            If ATWButton <> 0 Then
                Toolbars(SheetBar).ToolbarButtons(ATWButton).OnAction = _
                  TransName & "!DatabaseLink"
            Else
                Toolbars(SheetBar).ToolbarButtons(CalcButton).OnAction = _
                  TransName & "!Calc"
            End If

            If Windows(TransName).Visible = False Then
                Toolbars(SheetBar).Visible = False
            End If
        
        End If
    End If
    
    Specific_AutoStop
       
End Sub


Sub CheckSheet()
'Executed on worksheet changes

    If BookName = "" Then
        FullBookName = ActiveWorkbook.Name
        BookName = ParentWorkbook(ActiveWorkbook.Name)
    End If
    
    If TypeName(ActiveSheet) = cWorksheet Then
        ActiveSheet.TransitionExpEval = False
    End If
       
    Specific_CheckSheet
  
    'update status bars
    If CheckBars(SheetBar) Then
    
      Range(ToolBarStateCell) = Toolbars(SheetBar).Visible
      
      If TypeName(ActiveSheet) = cWorksheet And ActiveWindow.Type =
xlWorkbook Then
        
        'update zoom status
        Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = (ActiveWindow.
Zoom < ZoomFactor)

        'update split/freeze status
        If SplitButton > 0 Then
            Toolbars(SheetBar).ToolbarButtons(SplitButton).Pushed =
ActiveWindow.FreezePanes
        End If

        'update sample status
        Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed = Range
(SampleStateCell)
       
        'update celltip display status
        Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed = Not Application.
DisplayNoteIndicator
    
      Else
        For i = 1 To 6
            With Toolbars(SheetBar).ToolbarButtons(i)
                If .Enabled Then .Pushed = False
            End With
        Next
      End If
    End If
   
End Sub


Sub CloakSheet()
'manages hiding of vital sheet and closing of toolbars


    If CheckBars(SheetBar) Then
        On Error Resume Next
        Workbooks(FullBookName).Sheets(Vital).Range(ToolBarStateCell) =
Toolbars(SheetBar).Visible
        On Error GoTo 0
    End If
    
    'hides vital sheet
    On Error Resume Next
    If ActiveWindow.Type <> xlInfo Then
      On Error GoTo 0
      If TypeName(ActiveSheet) <> cNothing Then
        WorkbookName = ActiveWorkbook.Name
        If UCase(Right(WorkbookName, 4)) = ".XLS" _
         Or UCase(Right(WorkbookName, 4)) = ".XLT" Then _
         WorkbookName = Left(WorkbookName, Len(WorkbookName) - 4)
        If WorkbookName = FullBookName Then
            If ActiveSheet.Name <> Vital Then
                If Cloak_Next = True And Cloak = True Then
                    Sheets(Vital).Visible = False
                    Cloak_Next = False
                    Specific_AutoStart
                End If
            Else
                Cloak_Next = True
            End If
        End If
      End If
    End If
    On Error GoTo 0
    
    'closes old bar down
    If TypeName(ActiveWorkbook) = cNothing Then
        If CheckBars(SheetBar) Then
            Toolbars(SheetBar).Visible = False
        End If
    Else
        If BookName <> Left(ActiveWorkbook.Name, Len(BookName)) Then
            If CheckBars(SheetBar) Then
                Toolbars(SheetBar).Visible = False
            End If
        Else
            If LCase(Left(Right(ActiveWorkbook.Name, 12), 8)) = "database"
Then
                If CheckBars(SheetBar) Then
                    Toolbars(SheetBar).Visible = False
                End If
            End If
        End If
    End If
        
End Sub


Sub CheckWindow()

    If CheckBars(SheetBar) Then
        If LCase(BookName) = LCase(Left(ActiveWorkbook.Name, Len(BookName)))
_
         And LCase(Right(Trim(ActiveWorkbook.Name), 8)) <> "database" _
         And ActiveWindow.Type <> xlChartInPlace Then
            Toolbars(SheetBar).Visible = Range(ToolBarStateCell)
            CheckSheet
        Else
            Toolbars(SheetBar).Visible = False
        End If
    End If
    Application.StatusBar = False
    
End Sub


Sub CheckEntry()
'Executed on any entry in any cell

    If ActiveSheet.Name = Vital Then
        If LetterSize = 0 Then
            LetterSize = 10
        End If
        PreviewPane
    End If
        
End Sub


Sub AutoScale()
'scales the default zoom factor to the user's monitor size

    For Each ThisSheet In Sheets
      If TypeName(ThisSheet) = cWorksheet Then
        ThisSheet.Activate
        ActiveWindow.Zoom = ZoomFactor
      End If
    Next
    
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets(Content1).Activate
    
End Sub



' *******************************************
' *  Button and Toggle/States support code  *
' *******************************************


Sub PageZoom()
'Controls Zoom toolbar button

  If TypeName(ActiveSheet) = cWorksheet And TypeName(Selection) = cRange Then

    On Error GoTo Err_1
    
    Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = _
    Not Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed

    If Not Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed Then
        ActiveWindow.Zoom = ZoomFactor
    Else
        Application.ScreenUpdating = False
        Set ThisCell = ActiveCell
        Range("Print_Area").Select
        ActiveWindow.Zoom = True
        ThisCell.Select
        'Application.ScreenUpdating = True
    End If
  
  End If
  On Error GoTo 0
  Exit Sub

Err_1:

  Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = False
  'Application.ScreenUpdating = True
  Err = 0
  On Error GoTo 0

End Sub



Sub ToggleSample()
'Controls Sample toolbar button
      
    On Error GoTo Err_S:
    Selection.DataSeries
      
    Application.ScreenUpdating = False
    Set StartSheet = ActiveSheet
    
    For Each rngName In ActiveWorkbook.Names
        If InStr(rngName.Name, "qzqzqz") = 1 Then
            Range(rngName).MergeCells = False
        End If
    Next rngName

    For Each ThisSheet In Sheets
      If TypeName(ThisSheet) = cWorksheet Then
        ThisSheet.Activate
        If TypeName(Selection) <> cRange Then ThisSheet.Range("A1").Select
        PIndex = ThisSheet.Index
        For Each ThisScen In ThisSheet.Scenarios
            TName = ThisScen.Name
            TIndex = ThisScen.Index
            If Left(TName, 6) = "sample" Then
                Set SelCells = Sheets(PIndex).Scenarios(TName).ChangingCells
                ScenNo = Right(TName, Len(TName) - 6)
                ScenName = "current" & Trim(ScenNo)
                If Range(SampleStateCell).Value = False Then

                    If CheckScenarios(ScenName, PIndex) Then
                        ThisSheet.Scenarios(ScenName).Delete
                    End If
    
                    Sheets(PIndex).Scenarios.Add ScenName, SelCells
                    ThisScen.Show
                Else
                    ThisSheet.Scenarios(ScenName).Show
                End If
            End If
        Next
      End If
    Next

    Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed = _
    Not Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed
      
    Range(SampleStateCell).Value = _
    Not Range(SampleStateCell).Value
    
    For Each rngName In ActiveWorkbook.Names
        If InStr(rngName.Name, "qzqzqz") = 1 Then
            Range(rngName).MergeCells = True
        End If
    Next rngName
    
    StartSheet.Activate
    'Application.ScreenUpdating = True

Err_S:
End Sub



Sub AssignNumbers()
'Controls the Assign Numbers button on the toolbar
  
  On Error GoTo Err_S:
  If CheckAddIns(File_Number & ".XLA", Ttl) Then
    
    If ActiveWindow.Type = xlWorkbook Then
      If Range("NO") = "" Then
          If MsgBox(NUM_Warn1, vbOKCancel + vbInformation, SheetBar) =
vbCancel Then Exit Sub
      Else
          If MsgBox(NUM_Warn2, vbOKCancel + vbCritical, SheetBar) = vbCancel
Then Exit Sub
      End If

      UnqNumber = Application.Run(File_Number & ".XLA!GetNextTemplateNumber",
NumberingFilename, Not Range("SHR1").Value, Range("SHR2").Value, GenNumber)
      If UnqNumber <> "False" Then
        Range("NO").Value = UnqNumber
      Else
        MsgBox Num_Prob, vbOKOnly + vbExclamation, SheetBar
      End If
    End If
  
  Else
    
    MsgBox NUM_NotThere, vbOKOnly + vbCritical, SheetBar
  
  End If

Err_S:
End Sub



Sub CellTipDisplay()
'Controls the CellTip Display button on the toolbar
    
  If TypeName(ActiveSheet) = cWorksheet And ActiveWindow.Type = xlWorkbook
Then
    
    Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed = _
    Not Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed

    If Not Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed Then
        Application.DisplayNoteIndicator = True
    Else
        Application.DisplayNoteIndicator = False
    End If
    
  End If
    
End Sub



Sub LockSheet()
'Controls the Lock Sheet button on the Vitals page

    If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then
      
      If DialogSheets(LockDlg).Show Then
        Sheets(Vital).Protect DrawingObjects:=True, Contents:=True
        Sheets(Vital).DrawingObjects("Lock").Caption = Unlock_String
        Sheets(LockDlg).DialogFrame.Caption = Unlock_String
        Sheets(LockDlg).TextBoxes("PNL1_TXT1").Text = Unlock_Text
        Sheets(LockDlg).GroupBoxes("PNL2").Visible = False
        Sheets(LockDlg).OptionButtons("LCK_1").Visible = False
        Sheets(LockDlg).OptionButtons("LCK_2").Visible = False
        Sheets(LockDlg).TextBoxes("PNL1_TXT1").Height = 80
        If Sheets(LockDlg).OptionButtons("LCK_2").Value = xlOn Then
          ThisDir = CurDir()
          TempDir = Application.TemplatesPath
          ChDrive Mid(TempDir, 1, 1)
          ChDir TempDir
          FileNm = Application.GetSaveAsFilename(FileFilter:=Save_Filter,
Title:=Save_Title)
          If FileNm <> False Then
            OWFlg = Application.DisplayAlerts
            Application.DisplayAlerts = False
            ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
            Sheets(Content1).Activate
            Sheets(Vital).Visible = False
            With ActiveWorkbook
                .SaveAs Filename:=FileNm, FileFormat:=xlTemplate
                FName = .FullName
                PName = .Path
            End With
            Application.DisplayAlerts = OWFlg
            MsgBox Save_Alrt & PName & Save_Alrt2, vbOKOnly + vbInformation,
SheetBar
          End If
          ChDrive Mid(ThisDir, 1, 1)
          ChDir ThisDir
        End If
      End If
                        
    Else
        
      If DialogSheets(LockDlg).Show Then
        Sheets(Vital).Unprotect
        Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String
        Sheets(LockDlg).DialogFrame.Caption = Lock_String
        Sheets(LockDlg).TextBoxes("PNL1_TXT1").Text = Lock_Text
        Sheets(LockDlg).GroupBoxes("PNL2").Visible = True
        Sheets(LockDlg).OptionButtons("LCK_1").Visible = True
        Sheets(LockDlg).OptionButtons("LCK_2").Visible = True
        Sheets(LockDlg).TextBoxes("PNL1_TXT1").Height = 40
      End If
    
    End If

End Sub



Sub Customize()
'Controls Customize button on any Content Page

    Cloak_Next = True
    Sheets(Vital).Visible = True
    Sheets(Vital).Select
    CheckSheet

End Sub



' *********************************************************
' * Procedures which manage the logo and lettertype boxes *
' *********************************************************


Sub InsertLogo()
'Lets the user insert a custom logo

  Dim LoopL As Integer
  Dim LogpPic As Variant
  Dim Err_Flg As Boolean

  If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then

    ShtMem = ActiveSheet.Index

    Sheets(Vital).Activate
    Set Mem = ActiveCell

    With ActiveSheet.DrawingObjects("LG")
        lgl = .Left
        lgt = .Top
        lgw = .Width
        lgh = .Height
    End With

    On Error GoTo Err_1B
    
    If Application.Dialogs(xlDialogInsertPicture).Show Then

      Application.ScreenUpdating = False

      ActiveSheet.DrawingObjects("LG").Delete

      On Error GoTo Err_2

      With Selection
        .Left = lgl
        .Top = lgt
        .Width = lgw
        .Height = lgh
        .Width = lgw
        .Name = "LG"
        .OnAction = "Nada"
        .Copy
      End With

      Mem.Select

      For Each ThisSheet In Sheets
        If TypeName(ThisSheet) = cWorksheet Then

          ThisSheet.Activate
          Set Mem = ActiveCell
          ActiveSheet.DrawingObjects("LG").Select

          If Not Err_Flg Then

            With ActiveSheet.DrawingObjects("LG")
                lgl = .Left
                lgt = .Top
                lgw = .Width
                lgh = .Height
                .Delete
            End With

            ActiveSheet.Paste

            With Selection
                .Left = lgl
                .Top = lgt
                .Width = lgw
                .Height = lgh
                .Name = "LG"
                .OnAction = "Nada"
            End With

          Else
            Err_Flg = False
          End If

          Mem.Select
        End If
      Next

      Sheets(ShtMem).Activate
    End If

  Else

    MsgBox Logo_Error, vbCritical, SheetBar
  
  End If
      
  On Error GoTo 0
  'Application.ScreenUpdating = True
  Exit Sub
    
Err_1B:

  MsgBox Error(Err), vbCritical + vbOKOnly, SheetBar
  Err = 0
  'Application.ScreenUpdating = True
  On Error GoTo 0
  Exit Sub

Err_2:
    
  If Err <> 1004 And Err <> 1006 Then

    Msg = Univ_Error & Str(Err) & ": " & Error(Err)
    MsgBox Msg, vbCritical, SheetBar
    Err = 0
  Else
    Err_Flg = True
    Err = 0
    Resume Next
  End If

  Sheets(ShtMem).Activate
  On Error GoTo 0
  'Application.ScreenUpdating = True

End Sub


Sub PreviewPane()
'Adds text into the preview panels dynamically

  Dim Len1 As Integer
  Dim String1 As String
  Dim Thisbox As Variant
  Dim LoopA As Integer

  'Application.ScreenUpdating = False

  Len1 = Sheets(Vital).Range("vital1").Characters.Count

  If Not IsEmpty(Range("vital4")) And Not IsEmpty(Range("vital5")) Then
    Comma = ", "
  Else
    Comma = ""
  End If

  If Not IsEmpty(Range("vital9")) Then
    Fax = " fax "
  Else
    Fax = ""
  End If
    
  String1 = Sheets(Vital).Range("vital1").Value & Chr(10) _
    & Sheets(Vital).Range("vital2").Value & Chr(10) _
    & Sheets(Vital).Range("vital4").Value & Comma & Sheets(Vital).Range
("vital5").Value & "  " & Sheets(Vital).Range("vital6").Value _
    & Chr(10) & Sheets(Vital).Range("vital8").Value & Fax & Sheets(Vital).
Range("vital9")

  On Error GoTo Err_2B

  For Each ThisSheet In Sheets
    If TypeName(ThisSheet) = cWorksheet Then

      ThisSheet.DrawingObjects("LT").Characters.Text = String1

      If Err_Flg = False Then
        With ThisSheet.DrawingObjects("LT").Characters.Font
          .Name = LetterFont
          .ColorIndex = LetterColor
          .Size = LetterSize
          .Strikethrough = False
          .Superscript = False
          .Subscript = False
          .OutlineFont = False
          .Shadow = False
          .Underline = xlNone
          .FontStyle = LetterStyle
        End With

        With ThisSheet.DrawingObjects("LT").Characters(Start:=1, Length:=Len1)
.Font
          .Size = LetterSize + 10
          .FontStyle = LetterStyle
        End With

      Else
        Err_Flg = False
      End If
    End If
  Next

  On Error GoTo 0
  'Application.ScreenUpdating = True
  Exit Sub

Err_2B:

  If Err <> 1004 And Err <> 1006 Then

    Msg = Univ_Error & Str(Err) & ": " & Error(Err)
    MsgBox Msg, vbCritical, SheetBar
    Err = 0
  Else
    Err_Flg = True
    Err = 0
    Resume Next
  End If

  On Error GoTo 0
  'Application.ScreenUpdating = True

End Sub



' ************************************
' * Calls to customized dialog boxes *
' ************************************


Sub DatabaseLink()
'Auto-Template Wizard/ Database link box
'requires template add-in file for auto-numbering routine

    Dim GenNumber As Long
    On Error GoTo Err_S:

    If CheckAddIns(File_ATW & ".XLA", Ttl) Then
        Set CurrWorkbook = ActiveWorkbook
        AddIns(Ttl).Installed = True
        CurrWorkbook.Activate
        If DialogSheets("ATW").Show Then
            If DialogSheets("ATW").OptionButtons("ATW_1").Value = xlOn Then
                Application.Run File_ATW & ".XLA!StartWizard"
            Else
                Application.Run File_ATW & ".XLA!Commit"
            End If
        End If
    Else
    If MacXL Then
            File_Help_To_Call = File_Help_Main_Mac
        Else
            File_Help_To_Call = File_Help_Main
        End If

        MsgBox ATW_NotThere, vbOKOnly + vbCritical + vbMsgBoxHelpButton,
SheetBar, Application.Path & Application.PathSeparator & File_Help_To_Call,
5117208
    End If
    
Err_S:
End Sub


Sub VillageCredit()
'Village Software credits box

    MsgBox VIL_Dlg

End Sub


' ***********************************
' * Calls to Built-in Excel dialogs *
' ***********************************


Sub ChangeFont()
'Changes the font in the preview panels

  Dim Return_1 As Object

  If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then
    
    ShtMem = ActiveSheet.Index
    
    Sheets(Vital).Activate
    Set Return_1 = ActiveCell
    
    Sheets(Vital).Range("LTR").Select
    
    If Application.Dialogs(xlDialogActiveCellFont).Show Then
        With Selection.Font
            LetterFont = .Name
            LetterColor = .ColorIndex
            LetterSize = .Size
            LetterStyle = .FontStyle
            .Underline = xlNone
            PreviewPane
        End With
    End If
    
    Return_1.Select
    Sheets(ShtMem).Activate
  Else
  
    MsgBox LetterFont_Error, vbCritical, SheetBar
  End If

End Sub


' ***************************************
' * Supporting procedures and functions *
' ***************************************


Function CheckScenarios(ScenarioName, Scenariopage)
'Checks if a scenario is in a worksheet, returns T/F
    
    CheckScenarios = False
    If Scenariopage > 0 Then
        For Each ThisScenario In Sheets(Scenariopage).Scenarios
            If ThisScenario.Name = ScenarioName Then
                CheckScenarios = True
            End If
        Next
     End If
     
End Function


Function ParentWorkbook(WorkbookName)
'Returns the template parent name of the input workbookname

    If UCase(Right(WorkbookName, 4)) = ".XLS" _
     Or UCase(Right(WorkbookName, 4)) = ".XLT" Then
        WorkbookName = Left(WorkbookName, Len(WorkbookName) - 4)
    End If
    
    If IsNumeric(Right(WorkbookName, 1)) Then
        ParentWorkbook = ParentWorkbook(Left(WorkbookName, Len(WorkbookName) -
1))
    Else
        ParentWorkbook = WorkbookName
    End If
    
End Function


Function SiblingWorkbooks(WorkbookName, NumberHurdle)
'Checks if any other "offspring" workbooks are present, returns name or null
'NumberHurdle is how many siblings need be concurrently open to return non-
False

    i = 0
    SiblingWorkbooks = Null
    For Each ThisBook In Workbooks
        If UCase(WorkbookName) = Left(UCase(ThisBook.Name), Len(WorkbookName))
Then
            i = i + 1
            If TypeName(ActiveSheet) <> cNothing Then
                If ThisBook.Name <> ActiveWorkbook.Name Then
                    temp = ThisBook.Name
                End If
            End If
        End If
    Next
    
    If i > NumberHurdle Then
        SiblingWorkbooks = temp
    Else
        SiblingWorkbooks = Null
    End If
    
End Function


Function CheckSheets(SheetName, ThisBookName)
'Checks if a sheet is in a workbook, returns T/F

    NumberofSheets = Workbooks(ThisBookName).Sheets.Count
    CheckSheets = False
    On Error Resume Next
    Set ThisSheet = Workbooks(ThisBookName).Sheets(SheetName)
    If TypeName(ThisSheet) <> cEmpty Then
        CheckSheets = True
    End If
       
End Function


Function NameIndex(RName)
'Checks to see if a name is in a sheet, returns index

    Dim Count As Integer
    Dim Loop1 As Integer
    
    Count = ActiveWorkbook.Names.Count
    NameIndex = False
    For Loop1 = 1 To Count
        If ActiveWorkbook.Names(Index:=Loop1).Name = RName Then
            NameIndex = Loop1
        End If
    Next
    
End Function


Function CheckBars(BarName)
'Checks if a toolbar is in a worksheet, returns T/F

    CheckBars = False
    On Error Resume Next
    Set ThisToolbar = Toolbars(BarName)
    If TypeName(ThisToolbar) <> cEmpty Then
        'ThisToolbar.Visible = True
        CheckBars = True
    End If
       
End Function


Function CheckAddIns(AddInName, AddInTitle)
'Checks if an addin is available to Excel, returns T/F

    CheckAddIns = False
    On Error GoTo NotLoadedTrap
    AddInTitle = Workbooks(AddInName).Title
    CheckAddIns = True
    Exit Function
    
NotLoaded:
    On Error GoTo CantLoadTrap
    Workbooks.Open Application.LibraryPath & Application.PathSeparator &
AddInName
    AddInTitle = Workbooks(AddInName).Title
    CheckAddIns = True
    Exit Function
    
NotLoadedTrap:
    Resume NotLoaded
    
CantLoadTrap:
    CheckAddIns = False
    
End Function
    

Sub Unhide_Workbook(WBook)
'Unhides a hidden workbook, called on closedown

    For Each ThisWindow In Windows
        WWind = Trim(ThisWindow.Caption)
        If Not IsError(Application.Search(":", WWind)) Then
            WWind = Left(WWind, Application.Find(":", WWind) - 1)
        End If
        If WWind = WBook Then
            If ThisWindow.Visible = False Then _
             ThisWindow.Visible = True
        End If
    Next

End Sub



Function ZoomFactor()
'Returns the proper default zoom factor for the user's display
 
    Select Case ActiveWindow.Width
        Case 1 To 600
            ZoomFactor = Zoom1
        Case 601 To 1050
            ZoomFactor = Zoom2
        Case Else
            ZoomFactor = Zoom3
    End Select
    
End Function


Function FlName(PathName)
'Returns the file name from a full path name

    If InStr(PathName, Application.PathSeparator) > 0 Then
        FlName = FlName(Right(PathName, Len(PathName) - InStr(PathName,
Application.PathSeparator)))
    Else
        FlName = PathName
    End If

End Function


Sub Nada()
'This area intentionally left blank
End Sub


Sub Help()
'Call to help file
    If MacXL Then
        File_Help_To_Call = File_Help_Mac
    Else
        File_Help_To_Call = File_Help
    End If
    Application.Help Application.Path & Application.PathSeparator &
File_Help_To_Call, 2

End Sub



' ***************************************************
' * Procedures specific to this particular template *
' ***************************************************



Sub Specific_CheckSheet()
'Template specific routines to be run in CheckSheet

End Sub


Sub Specific_AutoStart()

    Range("data1").Value = Date

End Sub


Sub Specific_AutoStop()

End Sub


Sub INV_Payments()
'Subroutine managing the buttons on pages which have a Payment area


    If Range("data64") = 3 Then
        ActiveSheet.DrawingObjects("CCL").Visible = True
        Range("CCT").FormulaR1C1 = "=INDEX(CC,data65)"
    Else
        ActiveSheet.DrawingObjects("CCL").Visible = False
        Range("CCT").FormulaR1C1 = ""
    End If
    
End Sub

-- 
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/ms-excel/200912/1

Anyone considering helping the OP should be aware that the same query has been cross-posted to various forums and the OP is
unwilling to let on about this until a solution is provided - no matter how much re-inventing the wheel people in each forum might
go through to get there. For further info, see:
http://www.tek-tips.com/viewthread.cfm?qid=1584417&page=1
http://www.sqldrill.com/excel/miscellaneous-excel-subjects/997686-how-can-i-make-my-excel-invoice-template-work-office-2007-a.html
http://www.thecodecage.com/forumz/excel-miscellaneous/165179-how-can-i-make-my-excel-invoice-template-work-office-2007-a.html
http://www.sevenforums.com/software/49461-how-can-i-make-my-excel-2000-invoice-template-work.html
http://www.mrexcel.com/forum/showthread.php?t=437800
http://www.officekb.com/Uwe/Forums.aspx/ms-excel/200912/1

Note also that a new copy of the product retails for a paltry US$30-50 and it isn't designed for use with Office 2007 or later 
anyway (it uses a custom Excel 97-2003 toolbar). The maker's website makes this limitation quite clear.

-- 
Cheers
macropod
[Microsoft MVP - Word]


"jberenyi" <u57075@uwe> wrote in message news:a12b255f91506@uwe...
>I have put some serious hours into to trying to make this invoice template
> work with Office 2007 and Windows 7. It came originally with Office 97 and
> Office 2000 and was designed by Village Software for Excel usage. What is
> nice about it is that it has a visual basic database attached to it to track
> fields of data on the invoice. I have tried everything to make this darn
> thing work and I really need it for my business. The file names that I copied
> over to Windows 7 are:
>
> INVDB.XLS
> TMPLTNUM.XLS
> WZTEMPLT.XLS
>
> I pasted these files into location C:/Program Files (x86)/Microsoft
> Office/Office12/Library as some on the net have suggested to do in XP (except
> it would be Office11). I have successfully performed this feat in XP with
> Office 2003 but not Office 2007 in Windows 7. Keep in mind that I did change
> the file location of INVDB.XLS in the template but everytime I try to save
> the file it says "cannot locate ...INVDB.XLS". I also do not get the number
> toolbar to sequentially increase the invoice number manually.
>
> Has anyone successfully made this awesome template work with Office 2007? I
> know it can be done unless the VBA between the two Office versions are not
> compatible.
>
> I even created new folders for placement of the above three files in C:
> /Program Files/Microsoft Office/Office/Library and no go.
>