Advertisement
dissectmalware

OLVBA - XLSM + XLM macro

Apr 15th, 2020
401
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 39.84 KB | None | 0 0
  1. olevba 0.52 - http://decalage.info/python/oletools
  2. Flags Filename
  3. ----------- -----------------------------------------------------------------
  4. OpX:MAS-HB-- 63bacd873beeca6692142df432520614a1641ea395adaabc705152c55ab8c1d7
  5. ===============================================================================
  6. FILE: 63bacd873beeca6692142df432520614a1641ea395adaabc705152c55ab8c1d7
  7. Type: OpenXML
  8. -------------------------------------------------------------------------------
  9. VBA MACRO Makra.bas
  10. in file: xl/vbaProject.bin - OLE stream: 'VBA/Makra'
  11. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  12.  
  13.  
  14. ' **********************************************
  15. ' * MS-Excel\x99 Template Control Code *
  16. ' * Copyright \xa9 1994-6 Village Software, Inc. *
  17. ' * All Rights Reserved *
  18. ' * LICENSED FOR END-USER USE ONLY. *
  19. ' * CODE MAY NOT BE INCLUDED IN COMMERCIAL *
  20. ' * THIRD PARTY APPLICATIONS WITHOUT THE *
  21. ' * EXPRESSED WRITTEN CONSENT OF *
  22. ' * VILLAGE SOFTWARE, INC. *
  23. ' * *
  24. ' * Version 8.0 *
  25. ' **********************************************
  26.  
  27. ' These routines control the behavior of the toolbars,
  28. ' buttons, and other user-interface elements of the
  29. ' MS-Excel 97 templates
  30.  
  31.  
  32. ' ****************************************************
  33. ' * Global options, types, declarations, & constants *
  34. ' ****************************************************
  35.  
  36. Option Base 1
  37.  
  38. Public LetterFont As String
  39. Public LetterStyle As String
  40. Public LetterColor As Integer
  41. Public LetterSize As Integer
  42.  
  43. Public UnqNumber As Variant
  44. Public Cloak_Next As Boolean
  45. Public MacXL As Boolean
  46. Global GenNumber As Long
  47. Global BookName As String
  48. Global FullBookName As String
  49.  
  50. Const SheetBar = "Objedn\xe1vka"
  51. Const NumberingFilename = "Objedn\xe1vka"
  52. Const Vital = "\xdaprava objedn\xe1vky"
  53. Const Content1 = "Objedn\xe1vka"
  54.  
  55. Const Lock_String = "Zamknout / Ulo\x9eit list"
  56. Const Lock_Text = "Nyn\xed m\xf9\x9eete \xfadaje na tomto listu pro \xfapravy zamknout a p\xf8\xedpadn\xec zm\xecn\xecnou verzi \x9aablony ulo\x9eit."
  57. Const Unlock_String = "Odemknout tento list"
  58. Const Unlock_Text = "Odemknete-li tento list, m\xf9\x9eete na n\xecm prov\xe9st libovoln\xe9 \xfapravy. Po proveden\xed pot\xf8ebn\xfdch zm\xecn stiskn\xecte tla\xe8\xedtko """ & Lock_String & """ a zamkn\xecte jej. Ochr\xe1n\xedte jej tak p\xf8ed necht\xecn\xfdmi zm\xecnani."
  59. Const Save_Alrt = "Upraven\xe1 \x9aablona byla ulo\x9eena do slo\x9eky "
  60. Const Save_Alrt2 = ". Tuto \x9aablonu m\xf9\x9eete pou\x9e\xedt tak, \x9ee nejprve zvol\xedte p\xf8\xedkaz Zav\xf8\xedt z nab\xeddky Soubor a potom p\xf8\xedkaz Nov\xfd."
  61. Const Save_Filter = "\x8aablony,*.xlt"
  62. Const Save_Title = "Ulo\x9eit \x9aablonu"
  63.  
  64.  
  65. Const Logo_Error = "Logo \x9aablony nelze zm\xecnit. List mus\xedte nejprve odemknout."
  66. Const LetterFont_Error = "P\xedsmo \x9aablony nelze zm\xecnit. List mus\xedte nejprve odemknout."
  67. Const Univ_Error = "Neo\xe8ek\xe1van\xe1 chyba \xe8\xedslo "
  68.  
  69. Const ATW_NotThere = "Tuto funkci lze pou\x9e\xedt pouze pokud je nainstalov\xe1n Pr\xf9vodce \x9aablonou. Pokyny pro instalaci z\xedsk\xe1te klepnut\xedm na tla\xe8\xedtko N\xe1pov\xecda."
  70. Const ATW_SheetName = "TemplateInformation"
  71.  
  72.  
  73. Const SQ_DB_Loc = "V zadan\xe9m adres\xe1\xf8i nen\xed \x9e\xe1dn\xe1 spole\xe8n\xe1 datab\xe1ze. Zm\xec\xf2te pros\xedm nastaven\xed um\xedst\xecn\xed datab\xe1ze na listu \xdaprava objedn\xe1vky."
  74. Const SQ_DB_Struc = "Struktura datab\xe1ze nen\xed slu\xe8iteln\xe1 s p\xf8edlohou. Obnovte pros\xedm p\xf9vodn\xed strukturu."
  75. Const SQ_DB_CatTitle = "Katalog zbo\x9e\xed a slu\x9eeb"
  76. Const SQ_DB_CatItem = "N\xe1zev slu\x9eby/zbo\x9e\xed"
  77. Const SQ_DB_EmpTitle = "Zam\xecstnanci"
  78. Const SQ_DB_EmpItem = "Jm\xe9no"
  79.  
  80. Const NUM_Hdr = "P\xf8i\xf8a\xefit \xe8\xedslo"
  81. Const NUM_Warn1 = "\x8e\xe1d\xe1te o p\xf8i\xf8azen\xed jedine\xe8n\xe9ho \xe8\xedsla tomuto formul\xe1\xf8i. P\xf8ejete si pokra\xe8ovat?"
  82. Const NUM_Warn2 = "Tomuto formul\xe1\xf8i je ji\x9e p\xf8i\xf8azeno \xe8\xedslo. Zm\xecna m\xf9\x9ee zp\xf9sobit probl\xe9my. P\xf8ejete si opavdu p\xf8i\xf8adit nov\xe9 \xe8\xedslo?"
  83. Const NUM_NotThere = "Dopln\xeck pro \xe8\xedslov\xe1n\xed mus\xed b\xfdt otev\xf8en, aby \xe8\xedslov\xe1n\xed a funkce panelu n\xe1stroj\xf9 byla optim\xe1ln\xed. Um\xedst\xecte pros\xedm tento dopln\xeck do slo\x9eky Library."
  84. Const Num_Prob = "B\xechem pokusu o p\xf8i\xf8azen\xed \xe8\xedsla se objevila chyba. Ujist\xecte se, \x9ee cesta zadan\xe1 na listu \xdapravy objedn\xe1vky je platn\xe1, nebo zadejte \xe8\xedslo ru\xe8n\xec."
  85. Const VIL_Dlg = "Spole\xe8nost Village Software nab\xedz\xed r\xf9zn\xe9 \xf8e\x9aen\xe9 \xfalohy pro oblast obchodu a financ\xed ur\xe8en\xe9 pro aplikaci Excel - jak pro obchodn\xed tak i dom\xe1c\xed pou\x9eit\xed. Katalog z\xedsk\xe1te zdarma na tel. \xe8\xedsle 617-695-9332 nebo p\xedsemn\xec na adrese Village Software, 186 Lincoln Street, Boston MA 02111, USA."
  86. Const VIL_Dlg2 = "Zp\xect do se\x9aitu, se kter\xfdm jste pracovali, m\xf9\x9eete p\xf8epnout pomoc\xed p\xf8\xedkazu Okno v nab\xeddce."
  87. Const EmpDlg = "V\xfdb\xecr zam\xecstnance"
  88. Const LockDlg = "Z\xe1mek"
  89. Const CredDlg = "Z\xe1sluhy"
  90.  
  91. Const ZoomButton = 1
  92. Const TipButton = 2
  93. Const DocButton = 3
  94. Const HelpButton = 4
  95. Const SampleButton = 5
  96. Const NumbersButton = 6
  97. Const ATWButton = 7
  98. Const CredButton = 8
  99.  
  100. Const Zoom1 = 80
  101. Const Zoom2 = 95
  102. Const Zoom3 = 105
  103.  
  104. Const DatabasePathCell = "B3"
  105. Const LocalizationCell = "LOC"
  106. Const SampleStateCell = "SS"
  107. Const ToolbarStateCell = "NS"
  108. Const CommonDBPathCell = "CDB"
  109. Const ContentSheetCell = "CS"
  110.  
  111. Const File_ATW = "WZTEMPLT"
  112. Const File_Number = "TMPLTNUM"
  113. Const File_Help = "XLTMPL8.HLP"
  114. Const File_Help_Mac = "MS Excel Solutions Help"
  115. Const File_Help_Main = "XLMAIN8.HLP"
  116. Const File_Help_Main_Mac = "MS Excel Help"
  117. Const File_DB = "COMMON"
  118.  
  119. Const Cloak = True
  120. Const Default_Font = "Arial CE"
  121.  
  122. Const cRange = "Range"
  123. Const cWorksheet = "Worksheet"
  124. Const cNothing = "Nothing"
  125. Const cEmpty = "Empty"
  126.  
  127. 'For the intl.Fixup macro:
  128. Const TRIGGER_NAME = "__IntlFixup"
  129. Const TABLE_NAME = "__IntlFixupTable"
  130.  
  131.  
  132. ' ***********************************
  133. ' * Automatic execution procedures *
  134. ' ***********************************
  135.  
  136.  
  137. Sub Auto_Open()
  138. Attribute Auto_Open.VB_ProcData.VB_Invoke_Func = " \n14"
  139. 'Initializes the worksheet properties
  140.  
  141. Application.ScreenUpdating = False
  142. ' IntlFixup
  143.  
  144. MacXL = (UCase(Left(Application.OperatingSystem, 3)) = "MAC")
  145.  
  146. If CheckBars(SheetBar) Then
  147. If Int(Left(Application.Version, 1)) > 5 Then
  148. Toolbars(SheetBar).ToolbarButtons(ZoomButton).OnAction = "PageZoom"
  149. Toolbars(SheetBar).ToolbarButtons(TipButton).OnAction = "CellTipDisplay"
  150. Toolbars(SheetBar).ToolbarButtons(HelpButton).OnAction = "Help"
  151. Toolbars(SheetBar).ToolbarButtons(SampleButton).OnAction = "ToggleSample"
  152. Else
  153. Toolbars(SheetBar).Delete
  154. Exit Sub
  155. End If
  156. End If
  157.  
  158. If Not CheckAddIns(File_Number & ".XLA", Ttl) Then
  159. MsgBox NUM_NotThere, vbOKOnly + vbCritical, SheetBar
  160. End If
  161.  
  162. ActiveWorkbook.OnSheetActivate = "CheckSheet"
  163. ActiveWorkbook.OnSheetDeactivate = "CloakSheet"
  164. ActiveWindow.OnWindow = "CheckWindow"
  165.  
  166. For Each ThisSheet In Sheets
  167. If TypeName(ThisSheet) = cWorksheet Then
  168. ThisSheet.OnEntry = "CheckEntry"
  169. End If
  170. Next
  171.  
  172. LetterFont = Default_Font
  173. Application.DisplayNoteIndicator = True
  174.  
  175. FullBookName = ActiveWorkbook.Name
  176. BookName = ParentWorkbook(FullBookName)
  177.  
  178. AutoScale
  179.  
  180. Range(LocalizationCell) = Application.International(1)
  181. Range(ContentSheetCell) = Sheets(Content1).Name
  182. If CheckSheets(ATW_SheetName, ActiveWorkbook.Name) Then
  183. If Sheets(ATW_SheetName).Range(DatabasePathCell).Value = _
  184. FlName(Sheets(ATW_SheetName).Range(DatabasePathCell).Value) Then
  185. Sheets(ATW_SheetName).Range(DatabasePathCell).Value = Application.LibraryPath & _
  186. Application.PathSeparator & FlName(Sheets(ATW_SheetName).Range(DatabasePathCell).Value)
  187. End If
  188. End If
  189.  
  190. Specific_AutoStart
  191.  
  192. 'Application.ScreenUpdating = True
  193.  
  194. End Sub
  195.  
  196.  
  197. Sub IntlFixup()
  198. Attribute IntlFixup.VB_ProcData.VB_Invoke_Func = " \n14"
  199. Dim wbTemplate As Workbook
  200. Dim wbDataTable As Workbook
  201. Dim v As Variant
  202. Dim rTable As Range
  203. Dim rCurCell As Range
  204. Dim rDestCell As Range
  205. Dim iLocaleOffset As Integer
  206. Dim rSrcCell As Range
  207.  
  208. ' if somebody absolutely had to have the table in a different workbook,
  209. ' make it easy on them. Just change these definitions to affect the rest
  210. ' of the macro. Could also pass info as parameters if required.
  211. Set wbTemplate = ThisWorkbook
  212. Set wbDataTable = ThisWorkbook
  213.  
  214. On Error Resume Next
  215. Set v = Nothing
  216. Set v = wbTemplate.Names(TRIGGER_NAME)
  217. If Not (v Is Nothing) Then Exit Sub
  218.  
  219. Set rTable = wbDataTable.Names(TABLE_NAME).RefersToRange
  220. If rTable Is Nothing Then
  221. MsgBox "Warning: Missing Localization Table"
  222. Exit Sub
  223. End If
  224.  
  225. ' lookup the locale offset within the table. After found, it is just a constant
  226. ' offset into the table columns. If not found, bail out silently
  227. v = Application.Match(Application.International(xlCountrySetting), _
  228. rTable.Rows(1).Cells.Offset(0, 3).Resize(columnsize:=rTable.Columns.Count - 3), 0)
  229. If Not IsError(v) Then
  230. iLocaleOffset = CInt(v) - 1
  231.  
  232. Set rCurCell = rTable.Cells(2, 1)
  233. Do Until IsEmpty(rCurCell.Value)
  234. Set rDestCell = wbTemplate.Sheets(rCurCell.Value).Range(rCurCell.Offset(0, 1).Value)
  235. Set rSrcCell = rCurCell.Offset(0, 3 + iLocaleOffset)
  236. If Not IsEmpty(rSrcCell) Then
  237. Select Case rCurCell.Offset(0, 2).Value
  238. Case 1
  239. ' contents
  240. rDestCell.Value = rSrcCell.Value
  241. Case 2
  242. ' number format
  243. rDestCell.NumberFormatLocal = rSrcCell.Value
  244. Case 3
  245. ' formula
  246. rDestCell.Formula = "=" & rSrcCell.Formula
  247. Case 4
  248. ' paper size (applies to entire worksheet)
  249. rDestCell.Parent.PageSetup.PaperSize = rSrcCell.Value
  250. Case Else
  251. ' do nothing - a bogus entry in the localization table
  252. MsgBox "Warning: invalid action code entry in localization table"
  253. End Select
  254. End If
  255. Set rCurCell = rCurCell.Offset(1, 0)
  256. Loop
  257. End If
  258.  
  259. ' add the trigger name so that this template never gets fixed up again.
  260. wbTemplate.Names.Add Name:=TRIGGER_NAME, RefersTo:="=True", Visible:=False
  261. End Sub
  262.  
  263.  
  264. Sub Auto_Close()
  265. Attribute Auto_Close.VB_ProcData.VB_Invoke_Func = " \n14"
  266. 'Orderly closedown/pass-off of toolbars, etc.
  267.  
  268. Unhide_Workbook ThisWorkbook.Name
  269.  
  270. If CheckBars(SheetBar) Then
  271.  
  272. If BookName = "" Then
  273. BookName = ParentWorkbook(ActiveWorkbook.Name)
  274. End If
  275.  
  276. If IsNull(SiblingWorkbooks(BookName, 1)) Then
  277. Toolbars(SheetBar).Delete
  278. Application.OnWindow = ""
  279. Else
  280. TransName = SiblingWorkbooks(BookName, 1)
  281. Toolbars(SheetBar).ToolbarButtons(ZoomButton).OnAction = _
  282. TransName & "!PageZoom"
  283. Toolbars(SheetBar).ToolbarButtons(TipButton).OnAction = _
  284. TransName & "!CellTipDisplay"
  285. Toolbars(SheetBar).ToolbarButtons(HelpButton).OnAction = _
  286. TransName & "!Help"
  287. Toolbars(SheetBar).ToolbarButtons(SampleButton).OnAction = _
  288. TransName & "!ToggleSample"
  289.  
  290. If NumbersButton <> 0 Then
  291. Toolbars(SheetBar).ToolbarButtons(NumbersButton).OnAction = _
  292. TransName & "!AssignNumbers"
  293. Else
  294. Toolbars(SheetBar).ToolbarButtons(SplitButton).OnAction = _
  295. TransName & "!SplitWindow"
  296. End If
  297.  
  298. If ATWButton <> 0 Then
  299. Toolbars(SheetBar).ToolbarButtons(ATWButton).OnAction = _
  300. TransName & "!DatabaseLink"
  301. Else
  302. Toolbars(SheetBar).ToolbarButtons(CalcButton).OnAction = _
  303. TransName & "!Calc"
  304. End If
  305.  
  306. If Windows(TransName).Visible = False Then
  307. Toolbars(SheetBar).Visible = False
  308. End If
  309.  
  310. End If
  311. End If
  312.  
  313. Specific_AutoStop
  314.  
  315. End Sub
  316.  
  317.  
  318. Sub CheckSheet()
  319. Attribute CheckSheet.VB_ProcData.VB_Invoke_Func = " \n14"
  320. 'Executed on worksheet changes
  321.  
  322. If BookName = "" Then
  323. FullBookName = ActiveWorkbook.Name
  324. BookName = ParentWorkbook(ActiveWorkbook.Name)
  325. End If
  326.  
  327. Specific_CheckSheet
  328.  
  329. 'update status bars
  330. If CheckBars(SheetBar) Then
  331.  
  332. Range(ToolbarStateCell) = Toolbars(SheetBar).Visible
  333.  
  334. If TypeName(ActiveSheet) = cWorksheet And ActiveWindow.Type = xlWorkbook Then
  335.  
  336. 'update zoom status
  337. Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = (ActiveWindow.Zoom < ZoomFactor)
  338.  
  339. 'update split/freeze status
  340. If SplitButton > 0 Then
  341. Toolbars(SheetBar).ToolbarButtons(SplitButton).Pushed = ActiveWindow.FreezePanes
  342. End If
  343.  
  344. 'update sample status
  345. Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed = Range(SampleStateCell)
  346.  
  347. 'update celltip display status
  348. Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed = Not Application.DisplayNoteIndicator
  349.  
  350. Else
  351. For i = 1 To 6
  352. With Toolbars(SheetBar).ToolbarButtons(i)
  353. If .Enabled Then .Pushed = False
  354. End With
  355. Next
  356. End If
  357. End If
  358.  
  359. End Sub
  360.  
  361.  
  362. Sub CloakSheet()
  363. Attribute CloakSheet.VB_ProcData.VB_Invoke_Func = " \n14"
  364. 'manages hiding of vital sheet and closing of toolbars
  365.  
  366.  
  367. If CheckBars(SheetBar) Then
  368. On Error Resume Next
  369. Workbooks(FullBookName).Sheets(Vital).Range(ToolbarStateCell) = Toolbars(SheetBar).Visible
  370. On Error GoTo 0
  371. End If
  372.  
  373. 'hides vital sheet
  374. On Error Resume Next
  375. If ActiveWindow.Type <> xlInfo Then
  376. On Error GoTo 0
  377. If TypeName(ActiveSheet) <> cNothing Then
  378. WorkbookName = ActiveWorkbook.Name
  379. If UCase(Right(WorkbookName, 4)) = ".XLS" _
  380. Or UCase(Right(WorkbookName, 4)) = ".XLT" Then _
  381. WorkbookName = Left(WorkbookName, Len(WorkbookName) - 4)
  382. If WorkbookName = FullBookName Then
  383. If ActiveSheet.Name <> Vital Then
  384. If Cloak_Next = True And Cloak = True Then
  385. Sheets(Vital).Visible = False
  386. Cloak_Next = False
  387. Specific_AutoStart
  388. End If
  389. Else
  390. Cloak_Next = True
  391. End If
  392. End If
  393. End If
  394. End If
  395. On Error GoTo 0
  396.  
  397. 'closes old bar down
  398. If TypeName(ActiveWorkbook) = cNothing Then
  399. If CheckBars(SheetBar) Then
  400. Toolbars(SheetBar).Visible = False
  401. End If
  402. Else
  403. If BookName <> Left(ActiveWorkbook.Name, Len(BookName)) Then
  404. If CheckBars(SheetBar) Then
  405. Toolbars(SheetBar).Visible = False
  406. End If
  407. Else
  408. If LCase(Left(Right(ActiveWorkbook.Name, 12), 8)) = "database" Then
  409. If CheckBars(SheetBar) Then
  410. Toolbars(SheetBar).Visible = False
  411. End If
  412. End If
  413. End If
  414. End If
  415.  
  416. End Sub
  417.  
  418.  
  419.  
  420. Sub CheckWindow()
  421. Attribute CheckWindow.VB_ProcData.VB_Invoke_Func = " \n14"
  422.  
  423. If CheckBars(SheetBar) Then
  424. If LCase(BookName) = LCase(Left(ActiveWorkbook.Name, Len(BookName))) _
  425. And LCase(Right(Trim(ActiveWorkbook.Name), 8)) <> "database" _
  426. And ActiveWindow.Type <> xlChartInPlace Then
  427. Toolbars(SheetBar).Visible = Range(ToolbarStateCell)
  428. CheckSheet
  429. Else
  430. Toolbars(SheetBar).Visible = False
  431. End If
  432. End If
  433. Application.StatusBar = False
  434.  
  435. End Sub
  436.  
  437.  
  438. Sub CheckEntry()
  439. Attribute CheckEntry.VB_ProcData.VB_Invoke_Func = " \n14"
  440. 'Executed on any entry in any cell
  441.  
  442. If ActiveSheet.Name = Vital Then
  443. If LetterSize = 0 Then
  444. LetterSize = 10
  445. End If
  446. PreviewPane
  447. End If
  448.  
  449. End Sub
  450.  
  451.  
  452. Sub AutoScale()
  453. Attribute AutoScale.VB_ProcData.VB_Invoke_Func = " \n14"
  454. 'scales the default zoom factor to the user's monitor size
  455.  
  456. For Each ThisSheet In Sheets
  457. If TypeName(ThisSheet) = cWorksheet Then
  458. ThisSheet.Activate
  459. ActiveWindow.Zoom = ZoomFactor
  460. End If
  461. Next
  462.  
  463. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
  464. Sheets(Content1).Activate
  465.  
  466. End Sub
  467.  
  468.  
  469.  
  470. ' *******************************************
  471. ' * Button and Toggle/States support code *
  472. ' *******************************************
  473.  
  474.  
  475. Sub PageZoom()
  476. Attribute PageZoom.VB_ProcData.VB_Invoke_Func = " \n14"
  477. 'Controls Zoom toolbar button
  478.  
  479. If TypeName(ActiveSheet) = cWorksheet And TypeName(Selection) = cRange Then
  480.  
  481. On Error GoTo Err_1
  482.  
  483. Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = _
  484. Not Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed
  485.  
  486. If Not Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed Then
  487. ActiveWindow.Zoom = ZoomFactor
  488. Else
  489. Application.ScreenUpdating = False
  490. Set ThisCell = ActiveCell
  491. Range("Print_Area").Select
  492. ActiveWindow.Zoom = True
  493. ThisCell.Select
  494. 'Application.ScreenUpdating = True
  495. End If
  496.  
  497. End If
  498. On Error GoTo 0
  499. Exit Sub
  500.  
  501. Err_1:
  502.  
  503. Toolbars(SheetBar).ToolbarButtons(ZoomButton).Pushed = False
  504. 'Application.ScreenUpdating = True
  505. Err = 0
  506. On Error GoTo 0
  507.  
  508. End Sub
  509.  
  510.  
  511.  
  512. Sub ToggleSample()
  513. Attribute ToggleSample.VB_ProcData.VB_Invoke_Func = " \n14"
  514. 'Controls Sample toobar button
  515.  
  516. On Error GoTo Err_S:
  517. Selection.DataSeries
  518.  
  519. Application.ScreenUpdating = False
  520. Set StartSheet = ActiveSheet
  521.  
  522. For Each rngName In ActiveWorkbook.Names
  523. If InStr(rngName.Name, "qzqzqz") = 1 Then
  524. Range(rngName).MergeCells = False
  525. End If
  526. Next rngName
  527.  
  528. For Each ThisSheet In Sheets
  529. If TypeName(ThisSheet) = cWorksheet Then
  530. ThisSheet.Activate
  531. If TypeName(Selection) <> cRange Then ThisSheet.Range("A1").Select
  532. PIndex = ThisSheet.Index
  533. For Each ThisScen In ThisSheet.Scenarios
  534. TName = ThisScen.Name
  535. TIndex = ThisScen.Index
  536. If Left(TName, 6) = "sample" Then
  537. Set SelCells = Sheets(PIndex).Scenarios(TName).ChangingCells
  538. ScenNo = Right(TName, Len(TName) - 6)
  539. ScenName = "current" & Trim(ScenNo)
  540. If Range(SampleStateCell).Value = False Then
  541.  
  542. If CheckScenarios(ScenName, PIndex) Then
  543. ThisSheet.Scenarios(ScenName).Delete
  544. End If
  545.  
  546. Sheets(PIndex).Scenarios.Add ScenName, SelCells
  547. ThisScen.Show
  548. Else
  549. ThisSheet.Scenarios(ScenName).Show
  550. End If
  551. End If
  552. Next
  553. End If
  554. Next
  555.  
  556. Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed = _
  557. Not Toolbars(SheetBar).ToolbarButtons(SampleButton).Pushed
  558.  
  559. Range(SampleStateCell).Value = _
  560. Not Range(SampleStateCell).Value
  561.  
  562. For Each rngName In ActiveWorkbook.Names
  563. If InStr(rngName.Name, "qzqzqz") = 1 Then
  564. Range(rngName).MergeCells = True
  565. End If
  566. Next rngName
  567.  
  568. StartSheet.Activate
  569. 'Application.ScreenUpdating = True
  570.  
  571. Err_S:
  572. End Sub
  573.  
  574.  
  575. Sub AssignNumbers()
  576. Attribute AssignNumbers.VB_ProcData.VB_Invoke_Func = " \n14"
  577. 'Controls the Assign Numbers button on the toolbar
  578.  
  579. On Error GoTo Err_S:
  580. If CheckAddIns(File_Number & ".XLA", Ttl) Then
  581.  
  582. If ActiveWindow.Type = xlWorkbook Then
  583. If Range("NO") = "" Then
  584. If MsgBox(NUM_Warn1, vbOKCancel + vbInformation, SheetBar) = vbCancel Then Exit Sub
  585. Else
  586. If MsgBox(NUM_Warn2, vbOKCancel + vbCritical, SheetBar) = vbCancel Then Exit Sub
  587. End If
  588.  
  589. UnqNumber = Application.Run(File_Number & ".XLA!GetNextTemplateNumber", NumberingFilename, Not Range("SHR1").Value, Range("SHR2").Value, GenNumber)
  590. If UnqNumber <> "False" Then
  591. Range("NO").Value = UnqNumber
  592. Else
  593. MsgBox Num_Prob, vbOKOnly + vbExclamation, SheetBar
  594. End If
  595. End If
  596.  
  597. Else
  598.  
  599. MsgBox NUM_NotThere, vbOKOnly + vbCritical, SheetBar
  600.  
  601. End If
  602.  
  603. Err_S:
  604. End Sub
  605.  
  606.  
  607.  
  608.  
  609. Sub CellTipDisplay()
  610. Attribute CellTipDisplay.VB_ProcData.VB_Invoke_Func = " \n14"
  611. 'Controls the CellTip Display button on the toolbar
  612.  
  613. If TypeName(ActiveSheet) = cWorksheet And ActiveWindow.Type = xlWorkbook Then
  614.  
  615. Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed = _
  616. Not Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed
  617.  
  618. If Not Toolbars(SheetBar).ToolbarButtons(TipButton).Pushed Then
  619. Application.DisplayNoteIndicator = True
  620. Else
  621. Application.DisplayNoteIndicator = False
  622. End If
  623.  
  624. End If
  625.  
  626. End Sub
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633. Sub LockSheet()
  634. Attribute LockSheet.VB_ProcData.VB_Invoke_Func = " \n14"
  635. 'Controls the Lock Sheet button on the Vitals page
  636.  
  637. If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then
  638.  
  639. If DialogSheets(LockDlg).Show Then
  640. Sheets(Vital).Protect DrawingObjects:=True, Contents:=True
  641. Sheets(Vital).DrawingObjects("Lock").Caption = Unlock_String
  642. Sheets(LockDlg).DialogFrame.Caption = Unlock_String
  643. Sheets(LockDlg).TextBoxes("PNL1_TXT1").Text = Unlock_Text
  644. Sheets(LockDlg).GroupBoxes("PNL2").Visible = False
  645. Sheets(LockDlg).OptionButtons("LCK_1").Visible = False
  646. Sheets(LockDlg).OptionButtons("LCK_2").Visible = False
  647. Sheets(LockDlg).TextBoxes("PNL1_TXT1").Height = 80
  648. If Sheets(LockDlg).OptionButtons("LCK_2").Value = xlOn Then
  649. ThisDir = CurDir()
  650. TempDir = Application.TemplatesPath
  651. ChDrive Mid(TempDir, 1, 1)
  652. ChDir TempDir
  653. FileNm = Application.GetSaveAsFilename(FileFilter:=Save_Filter, Title:=Save_Title)
  654. If FileNm <> False Then
  655. OWFlg = Application.DisplayAlerts
  656. Application.DisplayAlerts = False
  657. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
  658. Sheets(Content1).Activate
  659. Sheets(Vital).Visible = False
  660. With ActiveWorkbook
  661. .SaveAs Filename:=FileNm, FileFormat:=xlTemplate
  662. FName = .FullName
  663. PName = .Path
  664. End With
  665. Application.DisplayAlerts = OWFlg
  666. MsgBox Save_Alrt & PName & Save_Alrt2, vbOKOnly + vbInformation, SheetBar
  667. End If
  668. ChDrive Mid(ThisDir, 1, 1)
  669. ChDir ThisDir
  670. End If
  671. End If
  672.  
  673. Else
  674.  
  675. If DialogSheets(LockDlg).Show Then
  676. Sheets(Vital).Unprotect
  677. Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String
  678. Sheets(LockDlg).DialogFrame.Caption = Lock_String
  679. Sheets(LockDlg).TextBoxes("PNL1_TXT1").Text = Lock_Text
  680. Sheets(LockDlg).GroupBoxes("PNL2").Visible = True
  681. Sheets(LockDlg).OptionButtons("LCK_1").Visible = True
  682. Sheets(LockDlg).OptionButtons("LCK_2").Visible = True
  683. Sheets(LockDlg).TextBoxes("PNL1_TXT1").Height = 40
  684. End If
  685.  
  686. End If
  687.  
  688. End Sub
  689.  
  690.  
  691.  
  692. Sub Customize()
  693. Attribute Customize.VB_ProcData.VB_Invoke_Func = " \n14"
  694. 'Controls Customize button on any Content Page
  695.  
  696. Cloak_Next = True
  697. Sheets(Vital).Visible = True
  698. Sheets(Vital).Select
  699. CheckSheet
  700.  
  701. End Sub
  702.  
  703.  
  704.  
  705.  
  706.  
  707. ' *********************************************************
  708. ' * Procedures which manage the logo and lettertype boxes *
  709. ' *********************************************************
  710.  
  711.  
  712. Sub InsertLogo()
  713. Attribute InsertLogo.VB_ProcData.VB_Invoke_Func = " \n14"
  714. 'Lets the user insert a custom logo
  715.  
  716. Dim LoopL As Integer
  717. Dim LogpPic As Variant
  718. Dim Err_Flg As Boolean
  719.  
  720. If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then
  721.  
  722. ShtMem = ActiveSheet.Index
  723.  
  724. Sheets(Vital).Activate
  725. Set Mem = ActiveCell
  726.  
  727. With ActiveSheet.DrawingObjects("LG")
  728. lgl = .Left
  729. lgt = .Top
  730. lgw = .Width
  731. lgh = .Height
  732. End With
  733.  
  734. On Error GoTo Err_1B
  735.  
  736. If Application.Dialogs(xlDialogInsertPicture).Show Then
  737.  
  738. Application.ScreenUpdating = False
  739.  
  740. ActiveSheet.DrawingObjects("LG").Delete
  741.  
  742. On Error GoTo Err_2
  743.  
  744. With Selection
  745. .Left = lgl
  746. .Top = lgt
  747. .Width = lgw
  748. .Height = lgh
  749. .Width = lgw
  750. .Name = "LG"
  751. .OnAction = "Nada"
  752. .Copy
  753. End With
  754.  
  755. Mem.Select
  756.  
  757. For Each ThisSheet In Sheets
  758. If TypeName(ThisSheet) = cWorksheet Then
  759.  
  760. ThisSheet.Activate
  761. Set Mem = ActiveCell
  762. ActiveSheet.DrawingObjects("LG").Select
  763.  
  764. If Not Err_Flg Then
  765.  
  766. With ActiveSheet.DrawingObjects("LG")
  767. lgl = .Left
  768. lgt = .Top
  769. lgw = .Width
  770. lgh = .Height
  771. .Delete
  772. End With
  773.  
  774. ActiveSheet.Paste
  775.  
  776. With Selection
  777. .Left = lgl
  778. .Top = lgt
  779. .Width = lgw
  780. .Height = lgh
  781. .Name = "LG"
  782. .OnAction = "Nada"
  783. End With
  784.  
  785. Else
  786. Err_Flg = False
  787. End If
  788.  
  789. Mem.Select
  790. End If
  791. Next
  792.  
  793. Sheets(ShtMem).Activate
  794. End If
  795.  
  796. Else
  797.  
  798. MsgBox Logo_Error, vbCritical, SheetBar
  799.  
  800. End If
  801.  
  802. On Error GoTo 0
  803. 'Application.ScreenUpdating = True
  804. Exit Sub
  805.  
  806. Err_1B:
  807.  
  808. MsgBox Error(Err), vbCritical + vbOKOnly, SheetBar
  809. Err = 0
  810. 'Application.ScreenUpdating = True
  811. On Error GoTo 0
  812. Exit Sub
  813.  
  814. Err_2:
  815.  
  816. If Err <> 1004 And Err <> 1006 Then
  817.  
  818. Msg = Univ_Error & Str(Err) & ": " & Error(Err)
  819. MsgBox Msg, vbCritical, SheetBar
  820. Err = 0
  821. Else
  822. Err_Flg = True
  823. Err = 0
  824. Resume Next
  825. End If
  826.  
  827. Sheets(ShtMem).Activate
  828. On Error GoTo 0
  829. 'Application.ScreenUpdating = True
  830.  
  831. End Sub
  832.  
  833.  
  834. Sub PreviewPane()
  835. Attribute PreviewPane.VB_ProcData.VB_Invoke_Func = " \n14"
  836. 'Adds text into the preview panels dynamically
  837.  
  838. Dim Len1 As Integer
  839. Dim String1 As String
  840. Dim Thisbox As Variant
  841. Dim LoopA As Integer
  842.  
  843. 'Application.ScreenUpdating = False
  844.  
  845. Len1 = Sheets(Vital).Range("vital1").Characters.Count
  846.  
  847. If Not IsEmpty(Range("vital8")) Then
  848. Tel = "tel. "
  849. CommaTel = " "
  850. Else
  851. Tel = ""
  852. CommaTel = ""
  853. End If
  854.  
  855. If Not IsEmpty(Range("vital9")) Then
  856. Fax = "fax "
  857. Else
  858. Fax = ""
  859. End If
  860. If Not IsEmpty(Range("vital5")) Then CommaPSC = " " Else CommaPSC = ""
  861.  
  862. String1 = Sheets(Vital).Range("vital1").Value & Chr(10) _
  863. & Sheets(Vital).Range("vital2").Value & Chr(10) _
  864. & Sheets(Vital).Range("vital5").Value & CommaPSC _
  865. & Sheets(Vital).Range("vital4").Value & Chr(10) _
  866. & Tel & Sheets(Vital).Range("vital8").Value & CommaTel _
  867. & Fax & Sheets(Vital).Range("vital9").Value
  868. On Error GoTo Err_2B
  869.  
  870. For Each ThisSheet In Sheets
  871. If TypeName(ThisSheet) = cWorksheet Then
  872.  
  873. ThisSheet.DrawingObjects("LT").Characters.Text = String1
  874.  
  875. If Err_Flg = False Then
  876. With ThisSheet.DrawingObjects("LT").Characters.Font
  877. .Name = LetterFont
  878. .ColorIndex = LetterColor
  879. .Size = LetterSize
  880. .Strikethrough = False
  881. .Superscript = False
  882. .Subscript = False
  883. .OutlineFont = False
  884. .Shadow = False
  885. .Underline = xlNone
  886. .FontStyle = LetterStyle
  887. End With
  888.  
  889. With ThisSheet.DrawingObjects("LT").Characters(Start:=1, Length:=Len1).Font
  890. .Size = LetterSize + 10
  891. .FontStyle = LetterStyle
  892. End With
  893.  
  894. Else
  895. Err_Flg = False
  896. End If
  897. End If
  898. Next
  899.  
  900. On Error GoTo 0
  901. 'Application.ScreenUpdating = True
  902. Exit Sub
  903.  
  904. Err_2B:
  905.  
  906. If Err <> 1004 And Err <> 1006 Then
  907.  
  908. Msg = Univ_Error & Str(Err) & ": " & Error(Err)
  909. MsgBox Msg, vbCritical, SheetBar
  910. Err = 0
  911. Else
  912. Err_Flg = True
  913. Err = 0
  914. Resume Next
  915. End If
  916.  
  917. On Error GoTo 0
  918. 'Application.ScreenUpdating = True
  919.  
  920. End Sub
  921.  
  922.  
  923.  
  924.  
  925.  
  926. ' ************************************
  927. ' * Calls to customized dialog boxes *
  928. ' ************************************
  929.  
  930.  
  931. Sub DatabaseLink()
  932. Attribute DatabaseLink.VB_ProcData.VB_Invoke_Func = " \n14"
  933. 'Auto-Template Wizard/ Database link box
  934. 'requires template add-in file for auto-numbering routine
  935.  
  936. Dim GenNumber As Long
  937. On Error GoTo Err_S:
  938.  
  939. If CheckAddIns(File_ATW & ".XLA", Ttl) Then
  940. Set CurrWorkbook = ActiveWorkbook
  941. AddIns(Ttl).Installed = True
  942. CurrWorkbook.Activate
  943. If DialogSheets("ATW").Show Then
  944. If DialogSheets("ATW").OptionButtons("ATW_1").Value = xlOn Then
  945. Application.Run File_ATW & ".XLA!StartWizard"
  946. Else
  947. Application.Run File_ATW & ".XLA!Commit"
  948. End If
  949. End If
  950. Else
  951. If MacXL Then
  952. File_Help_To_Call = File_Help_Main_Mac
  953. Else
  954. File_Help_To_Call = File_Help_Main
  955. End If
  956.  
  957. MsgBox ATW_NotThere, vbOKOnly + vbCritical + vbMsgBoxHelpButton, SheetBar, Application.Path & Application.PathSeparator & File_Help_To_Call, 5117208
  958.  
  959. End If
  960.  
  961. Err_S:
  962. End Sub
  963.  
  964.  
  965. Sub VillageCredit()
  966. Attribute VillageCredit.VB_ProcData.VB_Invoke_Func = " \n14"
  967. 'Village Software credits box
  968.  
  969. MsgBox VIL_Dlg
  970.  
  971. End Sub
  972.  
  973.  
  974.  
  975. ' ***********************************
  976. ' * Calls to Built-in Excel dialogs *
  977. ' ***********************************
  978.  
  979.  
  980. Sub ChangeFont()
  981. Attribute ChangeFont.VB_ProcData.VB_Invoke_Func = " \n14"
  982. 'Changes the font in the preview panels
  983.  
  984. Dim Return_1 As Object
  985.  
  986. If Sheets(Vital).DrawingObjects("Lock").Caption = Lock_String Then
  987.  
  988. ShtMem = ActiveSheet.Index
  989.  
  990. Sheets(Vital).Activate
  991. Set Return_1 = ActiveCell
  992.  
  993. Sheets(Vital).Range("LTR").Select
  994.  
  995. If Application.Dialogs(xlDialogActiveCellFont).Show Then
  996. With Selection.Font
  997. LetterFont = .Name
  998. LetterColor = .ColorIndex
  999. LetterSize = .Size
  1000. LetterStyle = .FontStyle
  1001. .Underline = xlNone
  1002. PreviewPane
  1003. End With
  1004. End If
  1005.  
  1006. Return_1.Select
  1007. Sheets(ShtMem).Activate
  1008. Else
  1009.  
  1010. MsgBox LetterFont_Error, vbCritical, SheetBar
  1011. End If
  1012.  
  1013. End Sub
  1014.  
  1015.  
  1016.  
  1017.  
  1018. ' ***************************************
  1019. ' * Supporting procedures and functions *
  1020. ' ***************************************
  1021.  
  1022.  
  1023. Function CheckScenarios(ScenarioName, Scenariopage)
  1024. Attribute CheckScenarios.VB_ProcData.VB_Invoke_Func = " \n14"
  1025. 'Checks if a scenario is in a worksheet, returns T/F
  1026.  
  1027. CheckScenarios = False
  1028. If Scenariopage > 0 Then
  1029. For Each ThisScenario In Sheets(Scenariopage).Scenarios
  1030. If ThisScenario.Name = ScenarioName Then
  1031. CheckScenarios = True
  1032. End If
  1033. Next
  1034. End If
  1035.  
  1036. End Function
  1037.  
  1038.  
  1039. Function ParentWorkbook(WorkbookName)
  1040. Attribute ParentWorkbook.VB_ProcData.VB_Invoke_Func = " \n14"
  1041. 'Returns the template parent name of the input workbookname
  1042.  
  1043. If UCase(Right(WorkbookName, 4)) = ".XLS" _
  1044. Or UCase(Right(WorkbookName, 4)) = ".XLT" Then
  1045. WorkbookName = Left(WorkbookName, Len(WorkbookName) - 4)
  1046. End If
  1047.  
  1048. If IsNumeric(Right(WorkbookName, 1)) Then
  1049. ParentWorkbook = ParentWorkbook(Left(WorkbookName, Len(WorkbookName) - 1))
  1050. Else
  1051. ParentWorkbook = WorkbookName
  1052. End If
  1053.  
  1054. End Function
  1055.  
  1056.  
  1057. Function SiblingWorkbooks(WorkbookName, NumberHurdle)
  1058. Attribute SiblingWorkbooks.VB_ProcData.VB_Invoke_Func = " \n14"
  1059. 'Checks if any other "offspring" workbooks are present, returns name or null
  1060. 'NumberHurdle is how many siblings need be concurrently open to return non-False
  1061.  
  1062. i = 0
  1063. SiblingWorkbooks = Null
  1064. For Each ThisBook In Workbooks
  1065. If UCase(WorkbookName) = Left(UCase(ThisBook.Name), Len(WorkbookName)) Then
  1066. i = i + 1
  1067. If TypeName(ActiveSheet) <> cNothing Then
  1068. If ThisBook.Name <> ActiveWorkbook.Name Then
  1069. temp = ThisBook.Name
  1070. End If
  1071. End If
  1072. End If
  1073. Next
  1074.  
  1075. If i > NumberHurdle Then
  1076. SiblingWorkbooks = temp
  1077. Else
  1078. SiblingWorkbooks = Null
  1079. End If
  1080.  
  1081. End Function
  1082.  
  1083.  
  1084. Function CheckSheets(SheetName, ThisBookName)
  1085. Attribute CheckSheets.VB_ProcData.VB_Invoke_Func = " \n14"
  1086. 'Checks if a sheet is in a workbook, returns T/F
  1087.  
  1088. NumberofSheets = Workbooks(ThisBookName).Sheets.Count
  1089. CheckSheets = False
  1090. On Error Resume Next
  1091. Set ThisSheet = Workbooks(ThisBookName).Sheets(SheetName)
  1092. If TypeName(ThisSheet) <> cEmpty Then
  1093. CheckSheets = True
  1094. End If
  1095.  
  1096. End Function
  1097.  
  1098.  
  1099. Function NameIndex(RName)
  1100. Attribute NameIndex.VB_ProcData.VB_Invoke_Func = " \n14"
  1101. 'Checks to see if a name is in a sheet, returns index
  1102.  
  1103. Dim Count As Integer
  1104. Dim Loop1 As Integer
  1105.  
  1106. Count = ActiveWorkbook.Names.Count
  1107. NameIndex = False
  1108. For Loop1 = 1 To Count
  1109. If ActiveWorkbook.Names(Index:=Loop1).Name = RName Then
  1110. NameIndex = Loop1
  1111. End If
  1112. Next
  1113.  
  1114. End Function
  1115.  
  1116.  
  1117. Function CheckBars(BarName)
  1118. Attribute CheckBars.VB_ProcData.VB_Invoke_Func = " \n14"
  1119. 'Checks if a toolbar is in a worksheet, returns T/F
  1120.  
  1121. CheckBars = False
  1122. On Error Resume Next
  1123. Set ThisToolbar = Toolbars(BarName)
  1124. If TypeName(ThisToolbar) <> cEmpty Then
  1125. CheckBars = True
  1126. End If
  1127.  
  1128. End Function
  1129.  
  1130.  
  1131. Function CheckAddIns(AddInName, AddInTitle)
  1132. Attribute CheckAddIns.VB_ProcData.VB_Invoke_Func = " \n14"
  1133. 'Checks if an addin is available to Excel, returns T/F
  1134.  
  1135. CheckAddIns = False
  1136. On Error GoTo NotLoadedTrap
  1137. AddInTitle = Workbooks(AddInName).Title
  1138. CheckAddIns = True
  1139. Exit Function
  1140.  
  1141. NotLoaded:
  1142. On Error GoTo CantLoadTrap
  1143. Workbooks.Open Application.LibraryPath & Application.PathSeparator & AddInName
  1144. AddInTitle = Workbooks(AddInName).Title
  1145. CheckAddIns = True
  1146. Exit Function
  1147.  
  1148. NotLoadedTrap:
  1149. Resume NotLoaded
  1150.  
  1151. CantLoadTrap:
  1152. CheckAddIns = False
  1153.  
  1154. End Function
  1155.  
  1156.  
  1157.  
  1158. Sub Unhide_Workbook(WBook)
  1159. Attribute Unhide_Workbook.VB_ProcData.VB_Invoke_Func = " \n14"
  1160. 'Unhides a hidden workbook, called on closedown
  1161.  
  1162. For Each ThisWindow In Windows
  1163. WWind = Trim(ThisWindow.Caption)
  1164. If Not IsError(Application.Search(":", WWind)) Then
  1165. WWind = Left(WWind, Application.Find(":", WWind) - 1)
  1166. End If
  1167. If WWind = WBook Then
  1168. If ThisWindow.Visible = False Then _
  1169. ThisWindow.Visible = True
  1170. End If
  1171. Next
  1172.  
  1173. End Sub
  1174.  
  1175.  
  1176.  
  1177. Function ZoomFactor()
  1178. Attribute ZoomFactor.VB_ProcData.VB_Invoke_Func = " \n14"
  1179. 'Returns the proper default zoom factor for the user's display
  1180.  
  1181. Select Case ActiveWindow.Width
  1182. Case 1 To 600
  1183. ZoomFactor = Zoom1
  1184. Case 601 To 1050
  1185. ZoomFactor = Zoom2
  1186. Case Else
  1187. ZoomFactor = Zoom3
  1188. End Select
  1189.  
  1190. End Function
  1191.  
  1192.  
  1193. Function FlName(PathName)
  1194. Attribute FlName.VB_ProcData.VB_Invoke_Func = " \n14"
  1195. 'Returns the file name from a full path name
  1196.  
  1197. If InStr(PathName, Application.PathSeparator) > 0 Then
  1198. FlName = FlName(Right(PathName, Len(PathName) - InStr(PathName, Application.PathSeparator)))
  1199. Else
  1200. FlName = PathName
  1201. End If
  1202.  
  1203. End Function
  1204.  
  1205.  
  1206. Sub Nada()
  1207. Attribute Nada.VB_ProcData.VB_Invoke_Func = " \n14"
  1208. 'This area intentionally left blank
  1209. End Sub
  1210.  
  1211.  
  1212. Sub Help()
  1213. Attribute Help.VB_ProcData.VB_Invoke_Func = " \n14"
  1214. 'Call to help file
  1215. If MacXL Then
  1216. File_Help_To_Call = File_Help_Mac
  1217. Else
  1218. File_Help_To_Call = File_Help
  1219. End If
  1220.  
  1221. Application.Help Application.Path & Application.PathSeparator & File_Help_To_Call, 3
  1222.  
  1223.  
  1224. End Sub
  1225.  
  1226.  
  1227.  
  1228. ' ***************************************************
  1229. ' * Procedures specific to this particular template *
  1230. ' ***************************************************
  1231.  
  1232.  
  1233. Sub Specific_CheckSheet()
  1234. Attribute Specific_CheckSheet.VB_ProcData.VB_Invoke_Func = " \n14"
  1235. 'Template specific routines to be run in CheckSheet
  1236.  
  1237. If ActiveSheet.Name = Range(ContentSheetCell) And Range("dflt1").Value = True Then
  1238. If IsEmpty(Range("data7").Value) And IsEmpty(Range("data8").Value) Then
  1239. If IsEmpty(Range("data7").Value) Then Range("data7").Value = Range("vital1").Value
  1240. If IsEmpty(Range("data8").Value) Then Range("data8").Value = Range("vital2").Value
  1241. If IsEmpty(Range("data9").Value) Then Range("data9").Value = Range("vital5").Value
  1242. If IsEmpty(Range("data10").Value) Then Range("data10").Value = Range("vital4").Value
  1243. If IsEmpty(Range("data12").Value) Then Range("data12").Value = Range("vital8").Value
  1244. If IsEmpty(Range("data102").Value) Then Range("data102").Value = Range("vital3").Value
  1245. If IsEmpty(Range("data103").Value) Then Range("data103").Value = Range("vital6").Value
  1246. If IsEmpty(Range("data104").Value) Then Range("data104").Value = Range("vital7").Value
  1247. End If
  1248. End If
  1249.  
  1250. End Sub
  1251.  
  1252.  
  1253. Sub Specific_AutoStart()
  1254. Attribute Specific_AutoStart.VB_ProcData.VB_Invoke_Func = " \n14"
  1255.  
  1256. Range("data101").Value = Now
  1257.  
  1258. End Sub
  1259.  
  1260.  
  1261. Sub Specific_AutoStop()
  1262. Attribute Specific_AutoStop.VB_ProcData.VB_Invoke_Func = " \n14"
  1263.  
  1264. End Sub
  1265.  
  1266.  
  1267. Sub PO_Payments()
  1268. Attribute PO_Payments.VB_ProcData.VB_Invoke_Func = " \n14"
  1269. 'Subroutine managing the buttons on pages which have a Payment area
  1270.  
  1271.  
  1272. If Range("data84") = 4 Then
  1273. ActiveSheet.DrawingObjects("CCL").Visible = True
  1274. Range("CCT").FormulaR1C1 = "=INDEX(CC,data83)"
  1275. Else
  1276. ActiveSheet.DrawingObjects("CCL").Visible = False
  1277. Range("CCT").FormulaR1C1 = ""
  1278. End If
  1279.  
  1280. End Sub
  1281.  
  1282.  
  1283. -------------------------------------------------------------------------------
  1284. VBA MACRO ThisWorkbook.cls
  1285. in file: xl/vbaProject.bin - OLE stream: 'VBA/ThisWorkbook'
  1286. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1287. (empty macro)
  1288. -------------------------------------------------------------------------------
  1289. VBA MACRO List1.cls
  1290. in file: xl/vbaProject.bin - OLE stream: 'VBA/List1'
  1291. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1292. (empty macro)
  1293. -------------------------------------------------------------------------------
  1294. VBA MACRO List2.cls
  1295. in file: xl/vbaProject.bin - OLE stream: 'VBA/List2'
  1296. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1297. (empty macro)
  1298. -------------------------------------------------------------------------------
  1299. VBA MACRO List3.cls
  1300. in file: xl/vbaProject.bin - OLE stream: 'VBA/List3'
  1301. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1302. (empty macro)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement