Tmpltnum.xla

tmpltnum.xla
olevba 0.52 – http://decalage.info/python/oletools
Flags Filename
———– —————————————————————–
OpX:MAS-HB– 63bacd873beeca6692142df432520614a1641ea395adaabc705152c55ab8c1d7
===============================================================================
FILE: 63bacd873beeca6692142df432520614a1641ea395adaabc705152c55ab8c1d7
Type: OpenXML
——————————————————————————-
VBA MACRO Makra.bas
in file: xl/vbaProject.bin – OLE stream: ‘VBA/Makra’
– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
tmpltnum.xla check more tmpltnum.xla

‘ **********************************************
‘ * MS-Excelx99 Template Control Code *
‘ * Copyright xa9 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 *
tmpltnum.xla tmpltnum.xla
‘ * VILLAGE SOFTWARE, INC. *
‘ * *
‘ * Version 8.0 *
‘ **********************************************

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

tmpltnum.xla informational tmpltnum.xla
‘ ****************************************************
‘ * Global options, types, declarations, & constants *
‘ ****************************************************

Option Base 1

Public LetterFont As String
Public LetterStyle As String
Public LetterColor As Integer
Public LetterSize As Integer
tmpltnum.xla tmpltnum.xla

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 = “Objednxe1vka”
Const NumberingFilename = “Objednxe1vka”
tmpltnum.xla informational tmpltnum.xla
Const Vital = “xdaprava objednxe1vky”
Const Content1 = “Objednxe1vka”

Const Lock_String = “Zamknout / Ulox9eit list”
Const Lock_Text = “Nynxed mxf9x9eete xfadaje na tomto listu pro xfapravy zamknout a pxf8xedpadnxec zmxecnxecnou verzi x9aablony ulox9eit.”
Const Unlock_String = “Odemknout tento list”
Const Unlock_Text = “Odemknete-li tento list, mxf9x9eete na nxecm provxe9st libovolnxe9 xfapravy. Po provedenxed potxf8ebnxfdch zmxecn stisknxecte tlaxe8xedtko “”” & Lock_String & “”” a zamknxecte jej. Ochrxe1nxedte jej tak pxf8ed nechtxecnxfdmi zmxecnani.”
Const Save_Alrt = “Upravenxe1 x9aablona byla ulox9eena do slox9eky ”
Const Save_Alrt2 = “. Tuto x9aablonu mxf9x9eete poux9exedt tak, x9ee nejprve zvolxedte pxf8xedkaz Zavxf8xedt z nabxeddky Soubor a potom pxf8xedkaz Novxfd.”
Const Save_Filter = “x8aablony,*.xlt”
tmpltnum.xla informational tmpltnum.xla
Const Save_Title = “Ulox9eit x9aablonu”

Const Logo_Error = “Logo x9aablony nelze zmxecnit. List musxedte nejprve odemknout.”
Const LetterFont_Error = “Pxedsmo x9aablony nelze zmxecnit. List musxedte nejprve odemknout.”
Const Univ_Error = “Neoxe8ekxe1vanxe1 chyba xe8xedslo ”

Const ATW_NotThere = “Tuto funkci lze poux9exedt pouze pokud je nainstalovxe1n Prxf9vodce x9aablonou. Pokyny pro instalaci zxedskxe1te klepnutxedm na tlaxe8xedtko Nxe1povxecda.”
Const ATW_SheetName = “TemplateInformation”

tmpltnum.xla best of tmpltnum.xla

Const SQ_DB_Loc = “V zadanxe9m adresxe1xf8i nenxed x9exe1dnxe1 spolexe8nxe1 databxe1ze. Zmxecxf2te prosxedm nastavenxed umxedstxecnxed databxe1ze na listu xdaprava objednxe1vky.”
Const SQ_DB_Struc = “Struktura databxe1ze nenxed sluxe8itelnxe1 s pxf8edlohou. Obnovte prosxedm pxf9vodnxed strukturu.”
Const SQ_DB_CatTitle = “Katalog zbox9exed a slux9eeb”
Const SQ_DB_CatItem = “Nxe1zev slux9eby/zbox9exed”
Const SQ_DB_EmpTitle = “Zamxecstnanci”
Const SQ_DB_EmpItem = “Jmxe9no”

Const NUM_Hdr = “Pxf8ixf8axefit xe8xedslo”
Const NUM_Warn1 = “x8exe1dxe1te o pxf8ixf8azenxed jedinexe8nxe9ho xe8xedsla tomuto formulxe1xf8i. Pxf8ejete si pokraxe8ovat?”
tmpltnum.xla informational tmpltnum.xla
Const NUM_Warn2 = “Tomuto formulxe1xf8i je jix9e pxf8ixf8azeno xe8xedslo. Zmxecna mxf9x9ee zpxf9sobit problxe9my. Pxf8ejete si opavdu pxf8ixf8adit novxe9 xe8xedslo?”
Const NUM_NotThere = “Doplnxeck pro xe8xedslovxe1nxed musxed bxfdt otevxf8en, aby xe8xedslovxe1nxed a funkce panelu nxe1strojxf9 byla optimxe1lnxed. Umxedstxecte prosxedm tento doplnxeck do slox9eky Library.”
Const Num_Prob = “Bxechem pokusu o pxf8ixf8azenxed xe8xedsla se objevila chyba. Ujistxecte se, x9ee cesta zadanxe1 na listu xdapravy objednxe1vky je platnxe1, nebo zadejte xe8xedslo ruxe8nxec.”
Const VIL_Dlg = “Spolexe8nost Village Software nabxedzxed rxf9znxe9 xf8ex9aenxe9 xfalohy pro oblast obchodu a financxed urxe8enxe9 pro aplikaci Excel – jak pro obchodnxed tak i domxe1cxed poux9eitxed. Katalog zxedskxe1te zdarma na tel. xe8xedsle 617-695-9332 nebo pxedsemnxec na adrese Village Software, 186 Lincoln Street, Boston MA 02111, USA.”
Const VIL_Dlg2 = “Zpxect do sex9aitu, se kterxfdm jste pracovali, mxf9x9eete pxf8epnout pomocxed pxf8xedkazu Okno v nabxeddce.”
Const EmpDlg = “Vxfdbxecr zamxecstnance”
Const LockDlg = “Zxe1mek”
Const CredDlg = “Zxe1sluhy”

Const ZoomButton = 1
tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla best of tmpltnum.xla
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”
tmpltnum.xla check more tmpltnum.xla
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 CE”

tmpltnum.xla informational tmpltnum.xla
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”

tmpltnum.xla tmpltnum.xla
‘ ***********************************
‘ * Automatic execution procedures *
‘ ***********************************

Sub Auto_Open()
Attribute Auto_Open.VB_ProcData.VB_Invoke_Func = ” n14″
‘Initializes the worksheet properties

Application.ScreenUpdating = False
tmpltnum.xla informational tmpltnum.xla
‘ 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”
tmpltnum.xla check more tmpltnum.xla
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

tmpltnum.xla informational tmpltnum.xla
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

tmpltnum.xla tmpltnum.xla
LetterFont = Default_Font
Application.DisplayNoteIndicator = True

FullBookName = ActiveWorkbook.Name
BookName = ParentWorkbook(FullBookName)

AutoScale

Range(LocalizationCell) = Application.International(1)
Range(ContentSheetCell) = Sheets(Content1).Name
tmpltnum.xla best of tmpltnum.xla
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

tmpltnum.xla informational tmpltnum.xla
‘Application.ScreenUpdating = True

End Sub

Sub IntlFixup()
Attribute IntlFixup.VB_ProcData.VB_Invoke_Func = ” n14″
Dim wbTemplate As Workbook
Dim wbDataTable As Workbook
Dim v As Variant
tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
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”
tmpltnum.xla informational tmpltnum.xla
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

tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla check more tmpltnum.xla
‘ 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
tmpltnum.xla best of tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla

Sub Auto_Close()
Attribute Auto_Close.VB_ProcData.VB_Invoke_Func = ” n14″
‘Orderly closedown/pass-off of toolbars, etc.

Unhide_Workbook ThisWorkbook.Name

If CheckBars(SheetBar) Then

tmpltnum.xla tmpltnum.xla
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 = _
tmpltnum.xla informational tmpltnum.xla
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 = _
tmpltnum.xla informational tmpltnum.xla
TransName & “!AssignNumbers”
Else
Toolbars(SheetBar).ToolbarButtons(SplitButton).OnAction = _
TransName & “!SplitWindow”
End If

If ATWButton 0 Then
Toolbars(SheetBar).ToolbarButtons(ATWButton).OnAction = _
TransName & “!DatabaseLink”
Else
tmpltnum.xla check more tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla

Specific_AutoStop

End Sub

Sub CheckSheet()
Attribute CheckSheet.VB_ProcData.VB_Invoke_Func = ” n14″
‘Executed on worksheet changes

tmpltnum.xla check more tmpltnum.xla
If BookName = “” Then
FullBookName = ActiveWorkbook.Name
BookName = ParentWorkbook(ActiveWorkbook.Name)
End If

Specific_CheckSheet

‘update status bars
If CheckBars(SheetBar) Then

tmpltnum.xla best of tmpltnum.xla
Range(ToolbarStateCell) = Toolbars(SheetBar).Visible

If TypeName(ActiveSheet) = cWorksheet And ActiveWindow.Type = xlWorkbook Then

‘update zoom status
Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = (ActiveWindow.Zoom 0 Then
Toolbars(SheetBar).ToolbarButtons(SplitButton).Pushed = ActiveWindow.FreezePanes
tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
With Toolbars(SheetBar).ToolbarButtons(i)
If .Enabled Then .Pushed = False
End With
Next
End If
End If

End Sub

tmpltnum.xla best of tmpltnum.xla
Sub CloakSheet()
Attribute CloakSheet.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla informational tmpltnum.xla

‘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)
tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla best of tmpltnum.xla
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
tmpltnum.xla best of tmpltnum.xla
End If
End If
End If

End Sub

Sub CheckWindow()
Attribute CheckWindow.VB_ProcData.VB_Invoke_Func = ” n14″
tmpltnum.xla tmpltnum.xla

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
tmpltnum.xla check more tmpltnum.xla
End If
Application.StatusBar = False

End Sub

Sub CheckEntry()
Attribute CheckEntry.VB_ProcData.VB_Invoke_Func = ” n14″
‘Executed on any entry in any cell

tmpltnum.xla informational tmpltnum.xla
If ActiveSheet.Name = Vital Then
If LetterSize = 0 Then
LetterSize = 10
End If
PreviewPane
End If

End Sub

tmpltnum.xla tmpltnum.xla
Sub AutoScale()
Attribute AutoScale.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla best of tmpltnum.xla

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Content1).Activate

End Sub

‘ *******************************************
‘ * Button and Toggle/States support code *
tmpltnum.xla check more tmpltnum.xla
‘ *******************************************

Sub PageZoom()
Attribute PageZoom.VB_ProcData.VB_Invoke_Func = ” n14″
‘Controls Zoom toolbar button

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

On Error GoTo Err_1
tmpltnum.xla best of tmpltnum.xla

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
tmpltnum.xla informational tmpltnum.xla
ActiveWindow.Zoom = True
ThisCell.Select
‘Application.ScreenUpdating = True
End If

End If
On Error GoTo 0
Exit Sub

Err_1:
tmpltnum.xla tmpltnum.xla

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

End Sub

tmpltnum.xla informational tmpltnum.xla
Sub ToggleSample()
Attribute ToggleSample.VB_ProcData.VB_Invoke_Func = ” n14″
‘Controls Sample toobar button

On Error GoTo Err_S:
Selection.DataSeries

Application.ScreenUpdating = False
Set StartSheet = ActiveSheet

tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla informational tmpltnum.xla
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

tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
Next
End If
Next

Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed = _
Not Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed

Range(SampleStateCell).Value = _
Not Range(SampleStateCell).Value

tmpltnum.xla tmpltnum.xla
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:
tmpltnum.xla informational tmpltnum.xla
End Sub

Sub AssignNumbers()
Attribute AssignNumbers.VB_ProcData.VB_Invoke_Func = ” n14″
‘Controls the Assign Numbers button on the toolbar

On Error GoTo Err_S:
If CheckAddIns(File_Number & “.XLA”, Ttl) Then

tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
Else
MsgBox Num_Prob, vbOKOnly + vbExclamation, SheetBar
End If
End If

Else

MsgBox NUM_NotThere, vbOKOnly + vbCritical, SheetBar

End If
tmpltnum.xla check more tmpltnum.xla

Err_S:
End Sub

Sub CellTipDisplay()
Attribute CellTipDisplay.VB_ProcData.VB_Invoke_Func = ” n14″
‘Controls the CellTip Display button on the toolbar
tmpltnum.xla check more tmpltnum.xla

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
tmpltnum.xla check more tmpltnum.xla
End If

End If

End Sub

tmpltnum.xla tmpltnum.xla

Sub LockSheet()
Attribute LockSheet.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla tmpltnum.xla
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)
tmpltnum.xla best of tmpltnum.xla
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
tmpltnum.xla check more tmpltnum.xla
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
tmpltnum.xla informational tmpltnum.xla

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
tmpltnum.xla check more tmpltnum.xla
Sheets(LockDlg).OptionButtons(“LCK_2”).Visible = True
Sheets(LockDlg).TextBoxes(“PNL1_TXT1″).Height = 40
End If

End If

End Sub

tmpltnum.xla check more tmpltnum.xla
Sub Customize()
Attribute Customize.VB_ProcData.VB_Invoke_Func = ” n14″
‘Controls Customize button on any Content Page

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

End Sub
tmpltnum.xla informational tmpltnum.xla

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

tmpltnum.xla informational tmpltnum.xla
Sub InsertLogo()
Attribute InsertLogo.VB_ProcData.VB_Invoke_Func = ” n14″
‘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

tmpltnum.xla tmpltnum.xla
ShtMem = ActiveSheet.Index

Sheets(Vital).Activate
Set Mem = ActiveCell

With ActiveSheet.DrawingObjects(“LG”)
lgl = .Left
lgt = .Top
lgw = .Width
lgh = .Height
tmpltnum.xla check more tmpltnum.xla
End With

On Error GoTo Err_1B

If Application.Dialogs(xlDialogInsertPicture).Show Then

Application.ScreenUpdating = False

ActiveSheet.DrawingObjects(“LG”).Delete

tmpltnum.xla informational tmpltnum.xla
On Error GoTo Err_2

With Selection
.Left = lgl
.Top = lgt
.Width = lgw
.Height = lgh
.Width = lgw
.Name = “LG”
.OnAction = “Nada”
tmpltnum.xla informational tmpltnum.xla
.Copy
End With

Mem.Select

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

ThisSheet.Activate
Set Mem = ActiveCell
tmpltnum.xla check more tmpltnum.xla
ActiveSheet.DrawingObjects(“LG”).Select

If Not Err_Flg Then

With ActiveSheet.DrawingObjects(“LG”)
lgl = .Left
lgt = .Top
lgw = .Width
lgh = .Height
.Delete
tmpltnum.xla best of tmpltnum.xla
End With

ActiveSheet.Paste

With Selection
.Left = lgl
.Top = lgt
.Width = lgw
.Height = lgh
.Name = “LG”
tmpltnum.xla best of tmpltnum.xla
.OnAction = “Nada”
End With

Else
Err_Flg = False
End If

Mem.Select
End If
Next
tmpltnum.xla tmpltnum.xla

Sheets(ShtMem).Activate
End If

Else

MsgBox Logo_Error, vbCritical, SheetBar

End If

tmpltnum.xla best of tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
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
tmpltnum.xla best of tmpltnum.xla
Err_Flg = True
Err = 0
Resume Next
End If

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

End Sub
tmpltnum.xla check more tmpltnum.xla

Sub PreviewPane()
Attribute PreviewPane.VB_ProcData.VB_Invoke_Func = ” n14″
‘Adds text into the preview panels dynamically

Dim Len1 As Integer
Dim String1 As String
Dim Thisbox As Variant
Dim LoopA As Integer
tmpltnum.xla best of tmpltnum.xla

‘Application.ScreenUpdating = False

Len1 = Sheets(Vital).Range(“vital1”).Characters.Count

If Not IsEmpty(Range(“vital8”)) Then
Tel = “tel. ”
CommaTel = ” ”
Else
Tel = “”
tmpltnum.xla best of tmpltnum.xla
CommaTel = “”
End If

If Not IsEmpty(Range(“vital9”)) Then
Fax = “fax ”
Else
Fax = “”
End If
If Not IsEmpty(Range(“vital5″)) Then CommaPSC = ” ” Else CommaPSC = “”

tmpltnum.xla check more tmpltnum.xla
String1 = Sheets(Vital).Range(“vital1”).Value & Chr(10) _
& Sheets(Vital).Range(“vital2”).Value & Chr(10) _
& Sheets(Vital).Range(“vital5”).Value & CommaPSC _
& Sheets(Vital).Range(“vital4”).Value & Chr(10) _
& Tel & Sheets(Vital).Range(“vital8”).Value & CommaTel _
& Fax & Sheets(Vital).Range(“vital9”).Value
On Error GoTo Err_2B

For Each ThisSheet In Sheets
If TypeName(ThisSheet) = cWorksheet Then
tmpltnum.xla best of tmpltnum.xla

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
tmpltnum.xla best of tmpltnum.xla
.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
tmpltnum.xla tmpltnum.xla
End With

Else
Err_Flg = False
End If
End If
Next

On Error GoTo 0
‘Application.ScreenUpdating = True
tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla check more tmpltnum.xla
Err_Flg = True
Err = 0
Resume Next
End If

On Error GoTo 0
‘Application.ScreenUpdating = True

End Sub

tmpltnum.xla check more tmpltnum.xla

‘ ************************************
‘ * Calls to customized dialog boxes *
‘ ************************************

Sub DatabaseLink()
tmpltnum.xla best of tmpltnum.xla
Attribute DatabaseLink.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla best of tmpltnum.xla
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
tmpltnum.xla check more tmpltnum.xla
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:
tmpltnum.xla check more tmpltnum.xla
End Sub

Sub VillageCredit()
Attribute VillageCredit.VB_ProcData.VB_Invoke_Func = ” n14″
‘Village Software credits box

MsgBox VIL_Dlg

End Sub
tmpltnum.xla informational tmpltnum.xla

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

Sub ChangeFont()
Attribute ChangeFont.VB_ProcData.VB_Invoke_Func = ” n14″
tmpltnum.xla check more tmpltnum.xla
‘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
tmpltnum.xla informational tmpltnum.xla

Sheets(Vital).Range(“LTR”).Select

If Application.Dialogs(xlDialogActiveCellFont).Show Then
With Selection.Font
LetterFont = .Name
LetterColor = .ColorIndex
LetterSize = .Size
LetterStyle = .FontStyle
.Underline = xlNone
tmpltnum.xla tmpltnum.xla
PreviewPane
End With
End If

Return_1.Select
Sheets(ShtMem).Activate
Else

MsgBox LetterFont_Error, vbCritical, SheetBar
End If
tmpltnum.xla informational tmpltnum.xla

End Sub

‘ ***************************************
‘ * Supporting procedures and functions *
‘ ***************************************

tmpltnum.xla check more tmpltnum.xla

Function CheckScenarios(ScenarioName, Scenariopage)
Attribute CheckScenarios.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla informational tmpltnum.xla
End If
Next
End If

End Function

Function ParentWorkbook(WorkbookName)
Attribute ParentWorkbook.VB_ProcData.VB_Invoke_Func = ” n14″
‘Returns the template parent name of the input workbookname
tmpltnum.xla check more tmpltnum.xla

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
tmpltnum.xla informational tmpltnum.xla
End If

End Function

Function SiblingWorkbooks(WorkbookName, NumberHurdle)
Attribute SiblingWorkbooks.VB_ProcData.VB_Invoke_Func = ” n14″
‘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

tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla tmpltnum.xla
End If
Next

If i > NumberHurdle Then
SiblingWorkbooks = temp
Else
SiblingWorkbooks = Null
End If

End Function
tmpltnum.xla check more tmpltnum.xla

Function CheckSheets(SheetName, ThisBookName)
Attribute CheckSheets.VB_ProcData.VB_Invoke_Func = ” n14″
‘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)
tmpltnum.xla tmpltnum.xla
If TypeName(ThisSheet) cEmpty Then
CheckSheets = True
End If

End Function

Function NameIndex(RName)
Attribute NameIndex.VB_ProcData.VB_Invoke_Func = ” n14″
‘Checks to see if a name is in a sheet, returns index
tmpltnum.xla tmpltnum.xla

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
tmpltnum.xla informational tmpltnum.xla
Next

End Function

Function CheckBars(BarName)
Attribute CheckBars.VB_ProcData.VB_Invoke_Func = ” n14″
‘Checks if a toolbar is in a worksheet, returns T/F

CheckBars = False
tmpltnum.xla check more tmpltnum.xla
On Error Resume Next
Set ThisToolbar = Toolbars(BarName)
If TypeName(ThisToolbar) cEmpty Then
CheckBars = True
End If

End Function

Function CheckAddIns(AddInName, AddInTitle)
tmpltnum.xla tmpltnum.xla
Attribute CheckAddIns.VB_ProcData.VB_Invoke_Func = ” n14″
‘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:
tmpltnum.xla check more tmpltnum.xla
On Error GoTo CantLoadTrap
Workbooks.Open Application.LibraryPath & Application.PathSeparator & AddInName
AddInTitle = Workbooks(AddInName).Title
CheckAddIns = True
Exit Function

NotLoadedTrap:
Resume NotLoaded

CantLoadTrap:
tmpltnum.xla informational tmpltnum.xla
CheckAddIns = False

End Function

Sub Unhide_Workbook(WBook)
Attribute Unhide_Workbook.VB_ProcData.VB_Invoke_Func = ” n14″
‘Unhides a hidden workbook, called on closedown

tmpltnum.xla informational tmpltnum.xla
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
tmpltnum.xla informational tmpltnum.xla

End Sub

Function ZoomFactor()
Attribute ZoomFactor.VB_ProcData.VB_Invoke_Func = ” n14″
‘Returns the proper default zoom factor for the user’s display

Select Case ActiveWindow.Width
tmpltnum.xla best of tmpltnum.xla
Case 1 To 600
ZoomFactor = Zoom1
Case 601 To 1050
ZoomFactor = Zoom2
Case Else
ZoomFactor = Zoom3
End Select

End Function

tmpltnum.xla informational tmpltnum.xla

Function FlName(PathName)
Attribute FlName.VB_ProcData.VB_Invoke_Func = ” n14″
‘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
tmpltnum.xla informational tmpltnum.xla

End Function

Sub Nada()
Attribute Nada.VB_ProcData.VB_Invoke_Func = ” n14″
‘This area intentionally left blank
End Sub

tmpltnum.xla tmpltnum.xla
Sub Help()
Attribute Help.VB_ProcData.VB_Invoke_Func = ” n14″
‘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, 3
tmpltnum.xla check more tmpltnum.xla

End Sub

‘ ***************************************************
‘ * Procedures specific to this particular template *
‘ ***************************************************

tmpltnum.xla informational tmpltnum.xla

Sub Specific_CheckSheet()
Attribute Specific_CheckSheet.VB_ProcData.VB_Invoke_Func = ” n14″
‘Template specific routines to be run in CheckSheet

If ActiveSheet.Name = Range(ContentSheetCell) And Range(“dflt1”).Value = True Then
If IsEmpty(Range(“data7”).Value) And IsEmpty(Range(“data8”).Value) Then
If IsEmpty(Range(“data7”).Value) Then Range(“data7”).Value = Range(“vital1”).Value
If IsEmpty(Range(“data8”).Value) Then Range(“data8”).Value = Range(“vital2”).Value
If IsEmpty(Range(“data9”).Value) Then Range(“data9”).Value = Range(“vital5”).Value
tmpltnum.xla check more tmpltnum.xla
If IsEmpty(Range(“data10”).Value) Then Range(“data10”).Value = Range(“vital4”).Value
If IsEmpty(Range(“data12”).Value) Then Range(“data12”).Value = Range(“vital8”).Value
If IsEmpty(Range(“data102”).Value) Then Range(“data102”).Value = Range(“vital3”).Value
If IsEmpty(Range(“data103”).Value) Then Range(“data103”).Value = Range(“vital6”).Value
If IsEmpty(Range(“data104”).Value) Then Range(“data104”).Value = Range(“vital7″).Value
End If
End If

End Sub

tmpltnum.xla informational tmpltnum.xla

Sub Specific_AutoStart()
Attribute Specific_AutoStart.VB_ProcData.VB_Invoke_Func = ” n14″

Range(“data101″).Value = Now

End Sub

Sub Specific_AutoStop()
tmpltnum.xla tmpltnum.xla
Attribute Specific_AutoStop.VB_ProcData.VB_Invoke_Func = ” n14″

End Sub

Sub PO_Payments()
Attribute PO_Payments.VB_ProcData.VB_Invoke_Func = ” n14″
‘Subroutine managing the buttons on pages which have a Payment area

tmpltnum.xla best of tmpltnum.xla
If Range(“data84”) = 4 Then
ActiveSheet.DrawingObjects(“CCL”).Visible = True
Range(“CCT”).FormulaR1C1 = “=INDEX(CC,data83)”
Else
ActiveSheet.DrawingObjects(“CCL”).Visible = False
Range(“CCT”).FormulaR1C1 = “”
End If

End Sub

tmpltnum.xla tmpltnum.xla

——————————————————————————-
VBA MACRO ThisWorkbook.cls
in file: xl/vbaProject.bin – OLE stream: ‘VBA/ThisWorkbook’
– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
(empty macro)
——————————————————————————-
VBA MACRO List1.cls
in file: xl/vbaProject.bin – OLE stream: ‘VBA/List1’
– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
tmpltnum.xla check more tmpltnum.xla
(empty macro)
——————————————————————————-
VBA MACRO List2.cls
in file: xl/vbaProject.bin – OLE stream: ‘VBA/List2’
– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
(empty macro)
——————————————————————————-
VBA MACRO List3.cls
in file: xl/vbaProject.bin – OLE stream: ‘VBA/List3’
– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
tmpltnum.xla check more tmpltnum.xla
(empty macro)
tmpltnum.xla

Jasc Paint Shop Pro 9 Free

Windows 7 Home Premium Oem Iso 64 Bit